Era-sensitive decoding of Alonzo genesis

IntersectMBO · Jul 24, 2024 · fe75ac1 · fe75ac1
1 parent b161938
commit fe75ac1
Show file tree

Hide file tree

Showing 21 changed files with 193 additions and 51 deletions.
diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal
@@ -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

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -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)

diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal
@@ -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

diff --git a/cabal.project b/cabal.project
@@ -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

diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal
@@ -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
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -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

diff --git a/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs b/cardano-node/src/Cardano/Node/Protocol/Alonzo.hs
@@ -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 ()

diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs
@@ -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
@@ -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 $

diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs
@@ -19,6 +19,7 @@ module Cardano.Node.Protocol.Shelley
   , readLeaderCredentials
   , genesisHashToPraosNonce
   , validateGenesis
+  , checkExpectedGenesisHash
   ) where
 
 import qualified Cardano.Api as Api
@@ -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
@@ -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 ()
@@ -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
 

diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Node.Types
   ( -- * Configuration
@@ -22,6 +24,7 @@ module Cardano.Node.Types
     -- * Consensus protocol configuration
   , NodeByronProtocolConfiguration(..)
   , NodeHardForkProtocolConfiguration(..)
+  , npcTestStartingEra
   , NodeProtocolConfiguration(..)
   , NodeShelleyProtocolConfiguration(..)
   , NodeAlonzoProtocolConfiguration(..)
@@ -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.
@@ -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)

diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal
@@ -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

diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -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

diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs
@@ -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

diff --git a/cardano-testnet/src/Testnet/Start/Cardano.hs b/cardano-testnet/src/Testnet/Start/Cardano.hs
@@ -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 :: ()

diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs
@@ -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

diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Gov/NoConfidence.hs
@@ -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
@@ -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 }

diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Node/Shutdown.hs
@@ -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'
@@ -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
@@ -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