Skip to content

Commit

Permalink
Merge pull request #5896 from IntersectMBO/mgalazyn/fix/make-plutus-v…
Browse files Browse the repository at this point in the history
…2-cost-model-era-dependent

Make Plutus v2 cost model decoding era dependent
  • Loading branch information
disassembler authored Jul 24, 2024
2 parents b161938 + 24b257c commit ac76baa
Show file tree
Hide file tree
Showing 25 changed files with 203 additions and 55 deletions.
2 changes: 1 addition & 1 deletion Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ ps: ## Plain-text list of profiles
##
PROFILES_BASE := default default-p2p plutus plutus-secp-ecdsa plutus-secp-schnorr oldtracing idle tracer-only
PROFILES_FAST := fast fast-solo fast-p2p fast-plutus fast-notracer fast-oldtracing faststartup-24M
PROFILES_CI_TEST := ci-test ci-test-p2p ci-test-plutus ci-test-notracer ci-test-rtview ci-test-dense10
PROFILES_CI_TEST := ci-test ci-test-p2p ci-test-plutus ci-test-notracer ci-test-rtview ci-test-dense10 ci-test-hydra
PROFILES_CI_BENCH := ci-bench ci-bench-p2p ci-bench-plutus ci-bench-plutus-secp-ecdsa ci-bench-plutus-secp-schnorr ci-bench-notracer ci-bench-rtview ci-bench-lmdb ci-bench-drep
PROFILES_CI_BENCH += ci-bench-plutusv3-blst ci-bench-plutus24
PROFILES_TRACE_BENCH := trace-bench trace-bench-notracer trace-bench-oldtracing trace-bench-rtview
Expand Down
2 changes: 1 addition & 1 deletion bench/plutus-scripts-bench/plutus-scripts-bench.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ library
-- IOG dependencies
--------------------------
build-depends:
, cardano-api ^>=9.0
, cardano-api ^>=9.1
, plutus-ledger-api ^>=1.30
, plutus-tx ^>=1.30
, plutus-tx-plugin ^>=1.30
Expand Down
2 changes: 1 addition & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,7 @@ makePlutusContext ScriptSpec{..} = do
scriptLang
version
(PScript script') -- TODO: add capability for reference inputs from Babbage era onwards
(ScriptDatumForTxIn scriptData)
(ScriptDatumForTxIn $ Just scriptData)
scriptRedeemer
executionUnits
in return (ScriptWitness ScriptWitnessForSpending scriptWitness, script, getScriptData scriptData, scriptFee)
Expand Down
4 changes: 2 additions & 2 deletions bench/tx-generator/tx-generator.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -106,9 +106,9 @@ library
, attoparsec-aeson
, base16-bytestring
, bytestring
, cardano-api ^>= 9.0
, cardano-api ^>= 9.1
, cardano-binary
, cardano-cli ^>= 9.0
, cardano-cli ^>= 9.2.1
, cardano-crypto-class
, cardano-crypto-wrapper
, cardano-data
Expand Down
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ repository cardano-haskell-packages
-- you need to run if you change them
index-state:
, hackage.haskell.org 2024-06-23T23:01:13Z
, cardano-haskell-packages 2024-07-03T01:26:49Z
, cardano-haskell-packages 2024-07-24T14:16:32Z

packages:
cardano-node
Expand Down
2 changes: 1 addition & 1 deletion cardano-node-chairman/cardano-node-chairman.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -88,5 +88,5 @@ test-suite chairman-tests
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T"

build-tool-depends: cardano-node:cardano-node
, cardano-cli:cardano-cli ^>= 9.0.0.0
, cardano-cli:cardano-cli ^>= 9.2.1
, cardano-node-chairman:cardano-node-chairman
2 changes: 1 addition & 1 deletion cardano-node/cardano-node.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -145,7 +145,7 @@ library
, async
, base16-bytestring
, bytestring
, cardano-api ^>= 9.0
, cardano-api ^>= 9.1
, cardano-crypto-class
, cardano-crypto-wrapper
, cardano-git-rev ^>=0.2.2
Expand Down
14 changes: 11 additions & 3 deletions cardano-node/src/Cardano/Node/Protocol/Alonzo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,24 +9,32 @@ module Cardano.Node.Protocol.Alonzo
) where

import Cardano.Api
import Cardano.Api.Shelley

import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo
import Cardano.Node.Orphans ()
import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny)
import Cardano.Node.Protocol.Shelley (GenesisReadError (..), checkExpectedGenesisHash)
import Cardano.Node.Types
import Cardano.Tracing.OrphanInstances.HardFork ()
import Cardano.Tracing.OrphanInstances.Shelley ()

import qualified Data.ByteString.Lazy as LBS


--
-- Alonzo genesis
--

readGenesis :: GenesisFile
readGenesis :: Maybe (CardanoEra era)
-> GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO
(Alonzo.AlonzoGenesis, GenesisHash)
readGenesis = readGenesisAny
readGenesis mEra (GenesisFile file) mGenesisHash = do
content <- handleIOExceptT (GenesisReadFileError file) $ LBS.readFile file
genesisHash <- checkExpectedGenesisHash (LBS.toStrict content) mGenesisHash
genesis <- modifyError (GenesisDecodeError file) $ decodeAlonzoGenesis mEra content
pure (genesis, genesisHash)

validateGenesis :: Alonzo.AlonzoGenesis
-> ExceptT AlonzoProtocolInstantiationError IO ()
Expand Down
13 changes: 10 additions & 3 deletions cardano-node/src/Cardano/Node/Protocol/Cardano.hs
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
npcConwayGenesisFile,
npcConwayGenesisFileHash
}
NodeHardForkProtocolConfiguration {
npc@NodeHardForkProtocolConfiguration {
npcExperimentalHardForksEnabled,
-- During testing of the Alonzo era, we conditionally declared that we
-- knew about the Alonzo era. We do so only when a config option for
Expand Down Expand Up @@ -125,8 +125,15 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {

(alonzoGenesis, _alonzoGenesisHash) <-
firstExceptT CardanoProtocolInstantiationAlonzoGenesisReadError $
Alonzo.readGenesis npcAlonzoGenesisFile
npcAlonzoGenesisFileHash
case npcTestStartingEra npc of
Nothing ->
Alonzo.readGenesis Nothing
npcAlonzoGenesisFile
npcAlonzoGenesisFileHash
Just (AnyShelleyBasedEra sbe) -> do
Alonzo.readGenesis (Just $ toCardanoEra sbe)
npcAlonzoGenesisFile
npcAlonzoGenesisFileHash

(conwayGenesis, _conwayGenesisHash) <-
firstExceptT CardanoProtocolInstantiationConwayGenesisReadError $
Expand Down
30 changes: 16 additions & 14 deletions cardano-node/src/Cardano/Node/Protocol/Shelley.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Cardano.Node.Protocol.Shelley
, readLeaderCredentials
, genesisHashToPraosNonce
, validateGenesis
, checkExpectedGenesisHash
) where

import qualified Cardano.Api as Api
Expand All @@ -44,6 +45,7 @@ import Ouroboros.Consensus.Shelley.Node (Nonce (..), ProtocolParams (.
ProtocolParamsShelleyBased (..), ShelleyLeaderCredentials (..))

import Control.Exception (IOException)
import Control.Monad
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.Text as T
Expand Down Expand Up @@ -101,22 +103,23 @@ readGenesisAny :: FromJSON genesis
=> GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (genesis, GenesisHash)
readGenesisAny (GenesisFile file) mbExpectedGenesisHash = do
content <- handleIOExceptT (GenesisReadFileError file) $
BS.readFile file
let genesisHash = GenesisHash (Crypto.hashWith id content)
checkExpectedGenesisHash genesisHash
readGenesisAny (GenesisFile file) mExpectedGenesisHash = do
content <- handleIOExceptT (GenesisReadFileError file) $ BS.readFile file
genesisHash <- checkExpectedGenesisHash content mExpectedGenesisHash
genesis <- firstExceptT (GenesisDecodeError file) $ hoistEither $
Aeson.eitherDecodeStrict' content
return (genesis, genesisHash)
where
checkExpectedGenesisHash :: GenesisHash
-> ExceptT GenesisReadError IO ()
checkExpectedGenesisHash actual =
case mbExpectedGenesisHash of
Just expected | actual /= expected
-> throwError (GenesisHashMismatch actual expected)
_ -> return ()

checkExpectedGenesisHash
:: BS.ByteString -- ^ genesis bytes
-> Maybe GenesisHash -- ^ expected hash, check for hash match, if provided
-> ExceptT GenesisReadError IO GenesisHash
checkExpectedGenesisHash genesisBytes mExpected = do
let actual = GenesisHash $ Crypto.hashWith id genesisBytes
forM_ mExpected $ \expected ->
when (actual /= expected) $
throwError (GenesisHashMismatch actual expected)
pure actual

validateGenesis :: ShelleyGenesis StandardCrypto
-> ExceptT GenesisValidationError IO ()
Expand Down Expand Up @@ -292,7 +295,6 @@ instance Error GenesisReadError where
"There was an error parsing the genesis file: "
<> pshow fp <> " Error: " <> pshow err


newtype GenesisValidationError = GenesisValidationErrors [Shelley.ValidationErr]
deriving Show

Expand Down
58 changes: 57 additions & 1 deletion cardano-node/src/Cardano/Node/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Node.Types
( -- * Configuration
Expand All @@ -22,6 +24,7 @@ module Cardano.Node.Types
-- * Consensus protocol configuration
, NodeByronProtocolConfiguration(..)
, NodeHardForkProtocolConfiguration(..)
, npcTestStartingEra
, NodeProtocolConfiguration(..)
, NodeShelleyProtocolConfiguration(..)
, NodeAlonzoProtocolConfiguration(..)
Expand All @@ -40,10 +43,11 @@ import Ouroboros.Network.NodeToNode (DiffusionMode (..))
import Control.Exception
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Monoid (Last)
import Data.Monoid (Last (..))
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable
import Data.Word (Word16, Word8)

-- | Errors for the cardano-config module.
Expand Down Expand Up @@ -283,6 +287,58 @@ data NodeHardForkProtocolConfiguration =
}
deriving (Eq, Show)

-- | Find the starting era for the test network, if it was configured.
--
-- Starting eras have zero defined as a forking epoch. So here we're taking the last zeroed configuration value.
-- Returns 'Nothing' if no @HardForkAt@ option is present, or all of them have non-zero value - meaning we are
-- starting from the very first era: Byron.
--
-- In mainnet config, the starting era is not configured, so this function will return 'Nothing'.
--
-- Introduced in https://github.com/IntersectMBO/cardano-node/pull/5896 as a part of the fix of reading
-- Plutus V2 cost model. Can be removed when era-sensitive AlonzoGenesis decoding gets removed.
npcTestStartingEra :: NodeHardForkProtocolConfiguration -> Maybe AnyShelleyBasedEra
npcTestStartingEra NodeHardForkProtocolConfiguration
{ npcTestShelleyHardForkAtEpoch
, npcTestShelleyHardForkAtVersion
, npcTestAllegraHardForkAtEpoch
, npcTestAllegraHardForkAtVersion
, npcTestMaryHardForkAtEpoch
, npcTestMaryHardForkAtVersion
, npcTestAlonzoHardForkAtEpoch
, npcTestAlonzoHardForkAtVersion
, npcTestBabbageHardForkAtEpoch
, npcTestBabbageHardForkAtVersion
, npcTestConwayHardForkAtEpoch
, npcTestConwayHardForkAtVersion
} =
getLast . mconcat $
[ checkIfInstantFork ShelleyBasedEraShelley (EpochNo 0) npcTestShelleyHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraShelley 0 npcTestShelleyHardForkAtVersion
, checkIfInstantFork ShelleyBasedEraAllegra (EpochNo 0) npcTestAllegraHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraAllegra 0 npcTestAllegraHardForkAtVersion
, checkIfInstantFork ShelleyBasedEraMary (EpochNo 0) npcTestMaryHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraMary 0 npcTestMaryHardForkAtVersion
, checkIfInstantFork ShelleyBasedEraAlonzo (EpochNo 0) npcTestAlonzoHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraAlonzo 0 npcTestAlonzoHardForkAtVersion
, checkIfInstantFork ShelleyBasedEraBabbage (EpochNo 0) npcTestBabbageHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraBabbage 0 npcTestBabbageHardForkAtVersion
, checkIfInstantFork ShelleyBasedEraConway (EpochNo 0) npcTestConwayHardForkAtEpoch
, checkIfInstantFork ShelleyBasedEraConway 0 npcTestConwayHardForkAtVersion
]
where
checkIfInstantFork :: Typeable era
=> Eq v
=> ShelleyBasedEra era
-> v -- ^ value indicating instant fork
-> Maybe v -- ^ config param
-> Last AnyShelleyBasedEra -- ^ Just era if instantly forking
checkIfInstantFork _ _ Nothing = Last Nothing
checkIfInstantFork sbe v (Just tv)
| tv == v = Last . Just $ AnyShelleyBasedEra sbe
| otherwise = Last Nothing


newtype TopologyFile = TopologyFile
{ unTopology :: FilePath }
deriving newtype (Show, Eq)
Expand Down
4 changes: 2 additions & 2 deletions cardano-submit-api/cardano-submit-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,9 @@ library
, aeson
, async
, bytestring
, cardano-api ^>= 9.0
, cardano-api ^>= 9.1
, cardano-binary
, cardano-cli ^>= 9.0
, cardano-cli ^>= 9.2.1
, cardano-crypto-class ^>= 2.1.2
, http-media
, iohk-monitoring
Expand Down
4 changes: 2 additions & 2 deletions cardano-testnet/cardano-testnet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -35,8 +35,8 @@ library
, aeson-pretty
, ansi-terminal
, bytestring
, cardano-api ^>= 9.0
, cardano-cli ^>= 9.0
, cardano-api ^>= 9.1
, cardano-cli ^>= 9.2.1
, cardano-crypto-class
, cardano-crypto-wrapper
, cardano-git-rev ^>= 0.2.2
Expand Down
6 changes: 3 additions & 3 deletions cardano-testnet/src/Testnet/Defaults.hs
Original file line number Diff line number Diff line change
Expand Up @@ -86,9 +86,9 @@ newtype AlonzoGenesisError
= AlonzoGenErrTooMuchPrecision Rational
deriving Show

defaultAlonzoGenesis :: Either AlonzoGenesisError AlonzoGenesis
defaultAlonzoGenesis = do
let genesis = Api.alonzoGenesisDefaults
defaultAlonzoGenesis :: CardanoEra era -> Either AlonzoGenesisError AlonzoGenesis
defaultAlonzoGenesis era = do
let genesis = Api.alonzoGenesisDefaults era
prices = Ledger.agPrices genesis

-- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api
Expand Down
8 changes: 5 additions & 3 deletions cardano-testnet/src/Testnet/Start/Cardano.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,16 +98,18 @@ cardanoTestnetDefault
-> Conf
-> H.Integration TestnetRuntime
cardanoTestnetDefault opts conf = do
alonzoGenesis <- H.evalEither $ first prettyError Defaults.defaultAlonzoGenesis
AnyCardanoEra cEra <- pure $ cardanoNodeEra cardanoDefaultTestnetOptions
alonzoGenesis <- getDefaultAlonzoGenesis cEra
(startTime, shelleyGenesis) <- getDefaultShelleyGenesis opts
cardanoTestnet opts conf startTime shelleyGenesis alonzoGenesis Defaults.defaultConwayGenesis

-- | An 'AlonzoGenesis' value that is fit to pass to 'cardanoTestnet'
getDefaultAlonzoGenesis :: ()
=> HasCallStack
=> MonadTest m
=> m AlonzoGenesis
getDefaultAlonzoGenesis = H.evalEither $ first prettyError Defaults.defaultAlonzoGenesis
=> CardanoEra era
-> m AlonzoGenesis
getDefaultAlonzoGenesis cEra = H.evalEither $ first prettyError (Defaults.defaultAlonzoGenesis cEra)

-- | A start time and 'ShelleyGenesis' value that are fit to pass to 'cardanoTestnet'
getDefaultShelleyGenesis :: ()
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,13 @@ hprop_transaction = integrationRetryWorkspace 0 "babbage-transaction" $ \tempAbs
txbodyFp <- H.note $ work </> "tx.body"
txbodySignedFp <- H.note $ work </> "tx.body.signed"

-- This is a double check that we can still deserialize Plutus V2 protocol parameters
void $ execCli' execConfig
[ anyEraToString cEra, "query", "protocol-parameters"
, "--cardano-mode"
, "--out-file", work </> "pparams.json"
]

void $ execCli' execConfig
[ anyEraToString cEra, "query", "utxo"
, "--address", Text.unpack $ paymentKeyInfoAddr wallet0
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@ import Cardano.Testnet
import Prelude

import Control.Monad
import Data.Bifunctor
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict
Expand Down Expand Up @@ -103,7 +102,7 @@ hprop_gov_no_confidence = integrationWorkspace "no-confidence" $ \tempAbsBasePat
committeeThreshold = unsafeBoundedRational 0.5
committee = L.Committee (Map.fromList [(comKeyCred1, EpochNo 100)]) committeeThreshold

alonzoGenesis <- evalEither $ first prettyError defaultAlonzoGenesis
alonzoGenesis <- getDefaultAlonzoGenesis era
(startTime, shelleyGenesis') <- getDefaultShelleyGenesis fastTestnetOptions
let conwayGenesisWithCommittee =
defaultConwayGenesis { L.cgCommittee = committee }
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H
logDir' = makeLogDir $ tempAbsPath conf
socketDir' = makeSocketDir $ tempAbsPath conf
testnetMagic' = 42
era = BabbageEra

-- TODO: We need to uniformly create these directories
H.createDirectoryIfMissing_ logDir'
Expand Down Expand Up @@ -101,7 +102,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H

-- 2. Create Alonzo genesis
alonzoBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath' </> shelleyDir </> "genesis.alonzo.spec.json"
gen <- Testnet.getDefaultAlonzoGenesis
gen <- Testnet.getDefaultAlonzoGenesis era
H.evalIO $ LBS.writeFile alonzoBabbageTestGenesisJsonTargetFile $ encode gen

-- 2. Create Conway genesis
Expand Down Expand Up @@ -130,7 +131,7 @@ hprop_shutdown = integrationRetryWorkspace 2 "shutdown" $ \tempAbsBasePath' -> H
$ mconcat [ byronGenesisHash
, shelleyGenesisHash
, alonzoGenesisHash
, defaultYamlHardforkViaConfig (AnyCardanoEra BabbageEra)] -- TODO: This should not be hardcoded
, defaultYamlHardforkViaConfig (AnyCardanoEra era)]

H.evalIO $ LBS.writeFile (tempAbsPath' </> "configuration.yaml") finalYamlConfig

Expand Down
Loading

0 comments on commit ac76baa

Please sign in to comment.