From ca6c23cb2279bae4d84bbfc4ae67d1ee6e3f3227 Mon Sep 17 00:00:00 2001 From: Konstantinos Lambrou-Latreille Date: Mon, 11 Nov 2024 14:26:33 -0500 Subject: [PATCH] Add unit tests which verify that we can use latest Plutus primitives (readbit, writebit) in mockchain. --- src/devnet/convex-devnet.cabal | 27 ++-- .../Devnet/Test/LatestEraTransitionSpec.hs | 100 ++++++++++++++ .../Test/LatestEraTransitionSpec/PV2.hs | 53 ++++++++ .../Test/LatestEraTransitionSpec/PV3.hs | 53 ++++++++ src/devnet/test/Spec.hs | 122 ++++++++++-------- .../lib/Convex/MockChain/Defaults.hs | 103 +++++++++++---- 6 files changed, 369 insertions(+), 89 deletions(-) create mode 100644 src/devnet/test/Devnet/Test/LatestEraTransitionSpec.hs create mode 100644 src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV2.hs create mode 100644 src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV3.hs diff --git a/src/devnet/convex-devnet.cabal b/src/devnet/convex-devnet.cabal index 224c97fa..bf8406c1 100644 --- a/src/devnet/convex-devnet.cabal +++ b/src/devnet/convex-devnet.cabal @@ -88,10 +88,10 @@ library , contra-tracer , iohk-monitoring - other-modules: - Paths_convex_devnet - autogen-modules: - Paths_convex_devnet + other-modules: + Paths_convex_devnet + autogen-modules: + Paths_convex_devnet test-suite convex-devnet-test import: lang @@ -99,21 +99,32 @@ test-suite convex-devnet-test main-is: Spec.hs ghc-options: -threaded -rtsopts other-modules: + Devnet.Test.LatestEraTransitionSpec + Devnet.Test.LatestEraTransitionSpec.PV2 + Devnet.Test.LatestEraTransitionSpec.PV3 hs-source-dirs: test build-depends: - base >= 4.14.0 - , tasty - , tasty-hunit , convex-devnet , convex-base , convex-node-client + , convex-wallet + , convex-coin-selection + , convex-mockchain + build-depends: + , plutus-tx + , plutus-tx-plugin , ouroboros-consensus-cardano + , plutus-core , ouroboros-consensus-protocol , cardano-api - , contra-tracer , cardano-ledger-api , cardano-ledger-core -any + build-depends: + base >= 4.14.0 + , tasty + , tasty-hunit + , contra-tracer , lens , mtl , aeson diff --git a/src/devnet/test/Devnet/Test/LatestEraTransitionSpec.hs b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec.hs new file mode 100644 index 00000000..214240af --- /dev/null +++ b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Devnet.Test.LatestEraTransitionSpec + ( tests + ) where + +import qualified Cardano.Api as C +import qualified Cardano.Api.Ledger as L +import Control.Lens ((&), (.~)) +import Convex.BuildTx (execBuildTx, + mintPlutus) +import Convex.Class (MonadMockchain) +import Convex.CoinSelection (ChangeOutputPosition (TrailingChange)) +import Convex.MockChain.CoinSelection (tryBalanceAndSubmit) +import qualified Convex.MockChain.Defaults as Defaults +import Convex.MockChain.Utils (mockchainFails, + mockchainFailsWith, + mockchainSucceeds) +import qualified Convex.NodeParams as Params +import Convex.Utils (failOnError) +import qualified Convex.Wallet.MockWallet as Wallet +import qualified Devnet.Test.LatestEraTransitionSpec.PV2 as LatestEraTransitionSpec.PV2 +import qualified Devnet.Test.LatestEraTransitionSpec.PV3 as LatestEraTransitionSpec.PV3 +import qualified PlutusTx.Builtins as BI +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase) + +tests :: TestTree +tests = do + testGroup "Latest era and protocol version tests" + [ testCase "usingReadBitInPlutusV2AndProtVer9ShouldFailSpec" usingReadBitInPlutusV2AndProtVer9ShouldFailSpec + , testCase "usingWriteBitInPlutusV2AndProtVer9ShouldFailSpec" usingWriteBitInPlutusV2AndProtVer9ShouldFailSpec + , testCase "usingReadBitInPlutusV3AndProtVer9ShouldFailSpec" usingReadBitInPlutusV3AndProtVer9ShouldFailSpec + , testCase "usingWriteBitInPlutusV3AndProtVer9ShouldFailSpec" usingWriteBitInPlutusV3AndProtVer9ShouldFailSpec + , testCase "usingReadBitInPlutusV2AndLatestProtVerShouldPassSpec" usingReadBitInPlutusV2AndLatestProtVerShouldPassSpec + , testCase "usingWriteBitInPlutusV2AndLatestProtVerShouldPassSpec" usingWriteBitInPlutusV2AndLatestProtVerShouldPassSpec + , testCase "usingReadBitInPlutusV3AndLatestProtVerShouldPassSpec" usingReadBitInPlutusV3AndLatestProtVerShouldPassSpec + , testCase "usingWriteBitInPlutusV3AndLatestProtVerShouldPassSpec" usingWriteBitInPlutusV3AndLatestProtVerShouldPassSpec + ] + +pv9NodeParams :: Params.NodeParams C.ConwayEra +pv9NodeParams = + Defaults.nodeParams + & Params.ledgerProtocolParameters . Params.protocolParameters . L.ppProtocolVersionL .~ L.ProtVer (toEnum 9) 0 + +usingReadBitInPlutusV2AndProtVer9ShouldFailSpec :: IO () +usingReadBitInPlutusV2AndProtVer9ShouldFailSpec = do + mockchainFailsWith pv9NodeParams (mintTokenScriptTest (LatestEraTransitionSpec.PV2.readBitTestMintingPolicyScriptPV2 $ BI.mkB "0xF4")) (const $ pure ()) + +usingWriteBitInPlutusV2AndProtVer9ShouldFailSpec :: IO () +usingWriteBitInPlutusV2AndProtVer9ShouldFailSpec = do + mockchainFailsWith pv9NodeParams (mintTokenScriptTest (LatestEraTransitionSpec.PV2.writeBitTestMintingPolicyScriptPV2 $ BI.mkB "0xFF")) (const $ pure ()) + +usingReadBitInPlutusV3AndProtVer9ShouldFailSpec :: IO () +usingReadBitInPlutusV3AndProtVer9ShouldFailSpec = do + mockchainFailsWith pv9NodeParams (mintTokenScriptTest (LatestEraTransitionSpec.PV3.readBitTestMintingPolicyScriptPV3 $ BI.mkB "0xF4")) (const $ pure ()) + +usingWriteBitInPlutusV3AndProtVer9ShouldFailSpec :: IO () +usingWriteBitInPlutusV3AndProtVer9ShouldFailSpec = do + mockchainFailsWith pv9NodeParams (mintTokenScriptTest (LatestEraTransitionSpec.PV3.writeBitTestMintingPolicyScriptPV3 $ BI.mkB "0xFF")) (const $ pure ()) + +usingReadBitInPlutusV2AndLatestProtVerShouldPassSpec :: IO () +usingReadBitInPlutusV2AndLatestProtVerShouldPassSpec = do + mockchainFails (mintTokenScriptTest (LatestEraTransitionSpec.PV2.readBitTestMintingPolicyScriptPV2 $ BI.mkB "0xF4")) (const $ pure ()) + +usingWriteBitInPlutusV2AndLatestProtVerShouldPassSpec :: IO () +usingWriteBitInPlutusV2AndLatestProtVerShouldPassSpec = do + mockchainFails (mintTokenScriptTest (LatestEraTransitionSpec.PV2.writeBitTestMintingPolicyScriptPV2 $ BI.mkB "0xFF")) (const $ pure ()) + +usingReadBitInPlutusV3AndLatestProtVerShouldPassSpec :: IO () +usingReadBitInPlutusV3AndLatestProtVerShouldPassSpec = do + mockchainSucceeds (mintTokenScriptTest (LatestEraTransitionSpec.PV3.readBitTestMintingPolicyScriptPV3 $ BI.mkB "0xF4")) + +usingWriteBitInPlutusV3AndLatestProtVerShouldPassSpec :: IO () +usingWriteBitInPlutusV3AndLatestProtVerShouldPassSpec = do + mockchainSucceeds (mintTokenScriptTest (LatestEraTransitionSpec.PV3.writeBitTestMintingPolicyScriptPV3 $ BI.mkB "0xFF")) + +mintTokenScriptTest :: + ( MonadMockchain era m + , C.IsPlutusScriptLanguage lang + , C.HasScriptLanguageInEra lang era + , C.IsBabbageBasedEra era + , MonadFail m + ) + => C.PlutusScript lang + -> m (C.Tx era) +mintTokenScriptTest script = do + let txb = + execBuildTx $ + mintPlutus script () (C.AssetName "ProtVer10Test") 1 + failOnError $ tryBalanceAndSubmit mempty Wallet.w1 txb TrailingChange [] diff --git a/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV2.hs b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV2.hs new file mode 100644 index 00000000..827b1aff --- /dev/null +++ b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV2.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:preserve-logging #-} + +module Devnet.Test.LatestEraTransitionSpec.PV2 + ( readBitTestMintingPolicyScriptPV2 + , writeBitTestMintingPolicyScriptPV2 + ) where + +import qualified Cardano.Api as C +import Convex.PlutusTx (compiledCodeToScript) +import qualified PlutusCore.Version as Version +import PlutusTx (CompiledCode) +import qualified PlutusTx +import qualified PlutusTx.Builtins.Internal as BI +import qualified PlutusTx.Prelude as PlutusTx + +{-# INLINABLE readBitTestMintingPolicy #-} +readBitTestMintingPolicy :: PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit +readBitTestMintingPolicy d _ _ = + if PlutusTx.readBit (BI.unsafeDataAsB d) 2 then BI.unitval else PlutusTx.error () + +readBitTestMintingPolicyScriptPV2 :: PlutusTx.BuiltinData -> C.PlutusScript C.PlutusScriptV2 +readBitTestMintingPolicyScriptPV2 = compiledCodeToScript . readBitTestMintingPolicyCompiled + where + readBitTestMintingPolicyCompiled :: PlutusTx.BuiltinData -> CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit) + readBitTestMintingPolicyCompiled str = + $$(PlutusTx.compile [|| \str' r c -> readBitTestMintingPolicy str' r c ||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode Version.plcVersion100 str + +{-# INLINABLE writeBitTestMintingPolicy #-} +writeBitTestMintingPolicy :: PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit +writeBitTestMintingPolicy d _ _ = + let !_ = PlutusTx.writeBits (BI.unsafeDataAsB d) [0] False in BI.unitval + +writeBitTestMintingPolicyScriptPV2 :: PlutusTx.BuiltinData -> C.PlutusScript C.PlutusScriptV2 +writeBitTestMintingPolicyScriptPV2 = compiledCodeToScript . writeBitTestMintingPolicyCompiled + where + writeBitTestMintingPolicyCompiled :: PlutusTx.BuiltinData -> CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit) + writeBitTestMintingPolicyCompiled str = + $$(PlutusTx.compile [|| \str' r c -> writeBitTestMintingPolicy str' r c ||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode Version.plcVersion100 str diff --git a/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV3.hs b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV3.hs new file mode 100644 index 00000000..4cc31e4e --- /dev/null +++ b/src/devnet/test/Devnet/Test/LatestEraTransitionSpec/PV3.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:preserve-logging #-} + +module Devnet.Test.LatestEraTransitionSpec.PV3 + ( readBitTestMintingPolicyScriptPV3 + , writeBitTestMintingPolicyScriptPV3 + ) where + +import qualified Cardano.Api as C +import Convex.PlutusTx (compiledCodeToScript) +import qualified PlutusCore.Version as Version +import PlutusTx (CompiledCode) +import qualified PlutusTx +import qualified PlutusTx.Builtins.Internal as BI +import qualified PlutusTx.Prelude as PlutusTx + +{-# INLINABLE readBitTestMintingPolicy #-} +readBitTestMintingPolicy :: PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit +readBitTestMintingPolicy d _ = + if PlutusTx.readBit (BI.unsafeDataAsB d) 2 then BI.unitval else PlutusTx.error () + +readBitTestMintingPolicyScriptPV3 :: PlutusTx.BuiltinData -> C.PlutusScript C.PlutusScriptV3 +readBitTestMintingPolicyScriptPV3 = compiledCodeToScript . readBitTestMintingPolicyCompiled + where + readBitTestMintingPolicyCompiled :: PlutusTx.BuiltinData -> CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit) + readBitTestMintingPolicyCompiled str = + $$(PlutusTx.compile [|| \str' c -> readBitTestMintingPolicy str' c ||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode Version.plcVersion110 str + +{-# INLINABLE writeBitTestMintingPolicy #-} +writeBitTestMintingPolicy :: PlutusTx.BuiltinData -> PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit +writeBitTestMintingPolicy d _ = + let !_ = PlutusTx.writeBits (BI.unsafeDataAsB d) [0] False in BI.unitval + +writeBitTestMintingPolicyScriptPV3 :: PlutusTx.BuiltinData -> C.PlutusScript C.PlutusScriptV3 +writeBitTestMintingPolicyScriptPV3 = compiledCodeToScript . writeBitTestMintingPolicyCompiled + where + writeBitTestMintingPolicyCompiled :: PlutusTx.BuiltinData -> CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinUnit) + writeBitTestMintingPolicyCompiled str = + $$(PlutusTx.compile [|| \str' c -> writeBitTestMintingPolicy str' c ||]) + `PlutusTx.unsafeApplyCode` PlutusTx.liftCode Version.plcVersion110 str diff --git a/src/devnet/test/Spec.hs b/src/devnet/test/Spec.hs index f78b25cb..673c440f 100644 --- a/src/devnet/test/Spec.hs +++ b/src/devnet/test/Spec.hs @@ -1,66 +1,76 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE GADTs #-} + module Main where -import qualified Cardano.Api as C -import qualified Cardano.Api.Shelley as C -import qualified Cardano.Api.Ledger as L -import Data.IORef (newIORef, modifyIORef, readIORef) -import Cardano.Ledger.Api.PParams qualified as L -import Cardano.Ledger.Slot (EpochSize (..)) -import qualified Cardano.Ledger.Block as Ledger -import Control.Concurrent (threadDelay) -import Control.Lens (view) -import Control.Monad (void, unless) -import Control.Monad.Except (runExceptT) -import Control.Tracer (Tracer) -import Convex.Devnet.CardanoNode (NodeLog (..), - getCardanoNodeVersion, - withCardanoNodeDevnet, - withCardanoNodeDevnetConfig, - withCardanoStakePoolNodeDevnetConfig) -import Convex.Devnet.CardanoNode.Types (GenesisConfigChanges (..), - PortsConfig (..), - RunningNode (..), - RunningStakePoolNode (..), - StakePoolNodeParams (..), - allowLargeTransactions, - defaultPortsConfig, - defaultStakePoolNodeParams) -import Convex.Devnet.Logging (contramap, showLogsOnFailure, - traceWith) -import Convex.Devnet.Utils (failAfter, failure, - withTempDir) -import Convex.Devnet.Wallet (WalletLog) -import qualified Convex.Devnet.Wallet as W -import Convex.Devnet.WalletServer (getUTxOs, withWallet) -import qualified Convex.Devnet.WalletServer as WS -import Convex.NodeQueries (loadConnectInfo, - queryProtocolParameters, - queryStakeAddresses, - queryStakePools) -import qualified Convex.NodeQueries as Queries -import qualified Convex.Utxos as Utxos -import Data.Aeson (FromJSON, ToJSON) -import Data.List (isInfixOf) -import qualified Data.Map as Map -import Data.Ratio ((%)) -import qualified Data.Set as Set -import GHC.Generics (Generic) -import GHC.IO.Encoding (setLocaleEncoding, utf8) -import System.FilePath (()) -import Test.Tasty (defaultMain, testGroup) -import Test.Tasty.HUnit (assertBool, assertEqual, - testCase) -import Convex.NodeClient.Types (runNodeClient) -import Convex.NodeClient.Fold (foldClient, LedgerStateArgs(NoLedgerStateArgs)) -import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Consensus -import Ouroboros.Consensus.Protocol.Praos.Header qualified as Consensus +import qualified Cardano.Api as C +import qualified Cardano.Api.Ledger as L +import qualified Cardano.Api.Shelley as C +import qualified Cardano.Ledger.Api.PParams as L +import qualified Cardano.Ledger.Block as Ledger +import Cardano.Ledger.Slot (EpochSize (..)) +import Control.Concurrent (threadDelay) +import Control.Lens (view) +import Control.Monad (unless, void) +import Control.Monad.Except (runExceptT) +import Control.Tracer (Tracer) +import Convex.Devnet.CardanoNode (NodeLog (..), + getCardanoNodeVersion, + withCardanoNodeDevnet, + withCardanoNodeDevnetConfig, + withCardanoStakePoolNodeDevnetConfig) +import Convex.Devnet.CardanoNode.Types (GenesisConfigChanges (..), + PortsConfig (..), + RunningNode (..), + RunningStakePoolNode (..), + StakePoolNodeParams (..), + allowLargeTransactions, + defaultPortsConfig, + defaultStakePoolNodeParams) +import Convex.Devnet.Logging (contramap, + showLogsOnFailure, + traceWith) +import Convex.Devnet.Utils (failAfter, failure, + withTempDir) +import Convex.Devnet.Wallet (WalletLog) +import qualified Convex.Devnet.Wallet as W +import Convex.Devnet.WalletServer (getUTxOs, + withWallet) +import qualified Convex.Devnet.WalletServer as WS +import Convex.NodeClient.Fold (LedgerStateArgs (NoLedgerStateArgs), + foldClient) +import Convex.NodeClient.Types (runNodeClient) +import Convex.NodeQueries (loadConnectInfo, + queryProtocolParameters, + queryStakeAddresses, + queryStakePools) +import qualified Convex.NodeQueries as Queries +import qualified Convex.Utxos as Utxos +import Data.Aeson (FromJSON, ToJSON) +import Data.IORef (modifyIORef, + newIORef, readIORef) +import Data.List (isInfixOf) +import qualified Data.Map as Map +import Data.Ratio ((%)) +import qualified Data.Set as Set +import qualified Devnet.Test.LatestEraTransitionSpec as LatestEraTransitionSpec +import GHC.Generics (Generic) +import GHC.IO.Encoding (setLocaleEncoding, + utf8) +import qualified Ouroboros.Consensus.Protocol.Praos.Header as Consensus +import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Consensus +import System.FilePath (()) +import Test.Tasty (defaultMain, + testGroup) +import Test.Tasty.HUnit (assertBool, + assertEqual, + testCase) main :: IO () main = do @@ -69,6 +79,7 @@ main = do [ testCase "cardano-node is available" checkCardanoNode , testCase "start local node" startLocalNode , testCase "check transition to conway era and protocol version 10" checkTransitionToConway + , LatestEraTransitionSpec.tests , testCase "make a payment" makePayment , testCase "start local stake pool node" startLocalStakePoolNode , testCase "stake pool registration" registeredStakePoolNode @@ -126,7 +137,6 @@ checkTransitionToConway = do assertBool "Should have correct conway era protocol version" $ not (null majorProtVersions) && all (== expectedVersion) majorProtVersions - startLocalStakePoolNode :: IO () startLocalStakePoolNode = do showLogsOnFailure $ \tr -> do diff --git a/src/mockchain/lib/Convex/MockChain/Defaults.hs b/src/mockchain/lib/Convex/MockChain/Defaults.hs index d46b8299..c3b8ebcd 100644 --- a/src/mockchain/lib/Convex/MockChain/Defaults.hs +++ b/src/mockchain/lib/Convex/MockChain/Defaults.hs @@ -91,32 +91,39 @@ epochSize = EpochSize 432_000 slotLength :: SlotLength slotLength = mkSlotLength 1 -- 1 second +latestProtVer :: L.ProtVer +latestProtVer = L.ProtVer (toEnum 10) 0 + -- FIXME: Make this era independent protocolParameters :: PParams StandardConway -protocolParameters = L.PParams $ - L.emptyPParamsIdentity @(ConwayEra StandardCrypto) - & L.hkdMaxBHSizeL .~ 1_100 - & L.hkdMaxBBSizeL .~ 90_112 - & L.hkdMaxTxSizeL .~ 16_384 - & L.hkdMinFeeAL .~ 44 - & L.hkdMinFeeBL .~ 155_381 - & L.hkdPoolDepositL .~ 500_000_000 - & L.hkdCoinsPerUTxOByteL .~ L.CoinPerByte 4_310 - & L.hkdPricesL .~ L.Prices - { L.prMem = C.unsafeBoundedRational (577 % 10_000) - , L.prSteps = C.unsafeBoundedRational (721 % 10_000_000) - } - & L.hkdMaxTxExUnitsL .~ ExUnits { exUnitsSteps = 1_0000_000_000, exUnitsMem = 14_000_000} - & L.hkdMaxBlockExUnitsL .~ ExUnits{ exUnitsSteps = 20_000_000_000, exUnitsMem = 62_000_000 } - & L.hkdMaxValSizeL .~ 5_000 - & L.hkdCollateralPercentageL .~ 150 - & L.hkdMaxCollateralInputsL .~ 3 - & L.hkdMinPoolCostL .~ 200_000 - & L.hkdCostModelsL .~ CostModels.mkCostModels (Map.fromList [(PlutusV1, v1CostModel), (PlutusV2, v2CostModel), (PlutusV3, v3CostModel)]) - & L.hkdMinFeeRefScriptCostPerByteL .~ C.unsafeBoundedRational 15 - & L.hkdMinPoolCostL .~ 170_000_000 - & L.hkdEMaxL .~ L.EpochInterval 18 +protocolParameters = + let pparams = L.PParams $ + L.emptyPParamsIdentity @(ConwayEra StandardCrypto) + & L.hkdMaxBHSizeL .~ 1_100 + & L.hkdMaxBBSizeL .~ 90_112 + & L.hkdMaxTxSizeL .~ 16_384 + & L.hkdMinFeeAL .~ 44 + & L.hkdMinFeeBL .~ 155_381 + & L.hkdPoolDepositL .~ 500_000_000 + & L.hkdCoinsPerUTxOByteL .~ L.CoinPerByte 4_310 + & L.hkdPricesL .~ L.Prices + { L.prMem = C.unsafeBoundedRational (577 % 10_000) + , L.prSteps = C.unsafeBoundedRational (721 % 10_000_000) + } + & L.hkdMaxTxExUnitsL .~ ExUnits { exUnitsSteps = 1_0000_000_000, exUnitsMem = 14_000_000} + & L.hkdMaxBlockExUnitsL .~ ExUnits{ exUnitsSteps = 20_000_000_000, exUnitsMem = 62_000_000 } + & L.hkdMaxValSizeL .~ 5_000 + & L.hkdCollateralPercentageL .~ 150 + & L.hkdMaxCollateralInputsL .~ 3 + & L.hkdMinPoolCostL .~ 200_000 + & L.hkdCostModelsL .~ CostModels.mkCostModels (Map.fromList [(PlutusV1, v1CostModel), (PlutusV2, v2CostModel), (PlutusV3, v3CostModel)]) + & L.hkdMinFeeRefScriptCostPerByteL .~ C.unsafeBoundedRational 15 + & L.hkdMinPoolCostL .~ 170_000_000 + & L.hkdEMaxL .~ L.EpochInterval 18 + in + pparams + & L.ppProtocolVersionL .~ latestProtVer unsafeMkCostModel :: Language -> [Int64] -> CostModels.CostModel unsafeMkCostModel lang = either (error . show) id . CostModels.mkCostModel lang @@ -474,7 +481,7 @@ v2CostModel = unsafeMkCostModel PlutusV2 v3CostModel :: CostModels.CostModel v3CostModel = unsafeMkCostModel PlutusV3 - [ + [ 100788, 420, 1, @@ -725,7 +732,53 @@ v3CostModel = unsafeMkCostModel PlutusV3 43623, 251, 0, - 1 + 1, + 100181, + 726, + 719, + 0, + 1, + 100181, + 726, + 719, + 0, + 1, + 100181, + 726, + 719, + 0, + 1, + 107878, + 680, + 0, + 1, + 95336, + 1, + 281145, + 18848, + 0, + 1, + 180194, + 159, + 1, + 1, + 158519, + 8942, + 0, + 1, + 159378, + 8813, + 0, + 1, + 107490, + 3298, + 1, + 106057, + 655, + 1, + 1964219, + 24520, + 3 ] globals :: C.IsShelleyBasedEra era => NodeParams era -> Globals