Merge pull request #5858 from IntersectMBO/jordan/enforce-pv8-if-no-c…

…onway-genesis-set

Enforce protocol version 8 if  "ConwayGenesisFile" is not set in node configuration

cardano-node/cardano-node.cabal

@@ -153,6 +153,7 @@ library
                       , cardano-ledger-allegra
                       , cardano-ledger-api
                       , cardano-ledger-babbage
+                      , cardano-ledger-binary
                       , cardano-ledger-byron
                       , cardano-ledger-conway
                       , cardano-ledger-core
@@ -163,6 +164,7 @@ library
                       , cborg ^>= 0.2.4
                       , containers
                       , contra-tracer
+                      , data-default-class
                       , deepseq
                       , directory
                       , dns

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -427,7 +427,7 @@ instance FromJSON PartialNodeConfiguration where
              }
 
       parseConwayProtocol v = do
-        npcConwayGenesisFile     <- v .:  "ConwayGenesisFile"
+        npcConwayGenesisFile     <- v .:?  "ConwayGenesisFile"
         npcConwayGenesisFileHash <- v .:? "ConwayGenesisHash"
         pure NodeConwayProtocolConfiguration {
                npcConwayGenesisFile

cardano-node/src/Cardano/Node/Protocol/Cardano.hs

@@ -40,6 +40,8 @@ import qualified Ouroboros.Consensus.Shelley.Node.Praos as Praos
 
 import           Prelude
 
+import           Data.Maybe
+
 ------------------------------------------------------------------------------
 -- Real Cardano protocol
 --
@@ -128,8 +130,8 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
 
     (conwayGenesis, _conwayGenesisHash) <-
       firstExceptT CardanoProtocolInstantiationConwayGenesisReadError $
-        Conway.readGenesis npcConwayGenesisFile
-                           npcConwayGenesisFileHash
+        Conway.readGenesisMaybe npcConwayGenesisFile
+                                npcConwayGenesisFileHash
 
     shelleyLeaderCredentials <-
       firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $
@@ -239,9 +241,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
           --
           -- If Conway is enabled, this is the Conway protocol version.
           Praos.conwayProtVer =
-            if npcExperimentalHardForksEnabled
-              then ProtVer (natVersion @10) 0
-              else ProtVer (natVersion @8) 0,
+            if isNothing npcConwayGenesisFile
+            then ProtVer (natVersion @8) 0
+            else if npcExperimentalHardForksEnabled
+                 then ProtVer (natVersion @10) 0
+                 else ProtVer (natVersion @8) 0,
           Praos.conwayMaxTxCapacityOverrides =
             TxLimits.mkOverrides TxLimits.noOverridesMeasure
         }

cardano-node/src/Cardano/Node/Protocol/Conway.hs

@@ -1,27 +1,109 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Node.Protocol.Conway
   ( ConwayProtocolInstantiationError(..)
     -- * Reusable parts
   , readGenesis
+  , readGenesisMaybe
   , validateGenesis
   ) where
 
 import           Cardano.Api
 
+import qualified Cardano.Crypto.Hash.Class as Crypto
+import           Cardano.Ledger.BaseTypes
+import qualified Cardano.Ledger.Binary as L
+import           Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
 import qualified Cardano.Ledger.Conway.Genesis as Conway
+import           Cardano.Ledger.Conway.PParams
+import qualified Cardano.Ledger.Plutus.CostModels as L
+import qualified Cardano.Ledger.Plutus.Language as L
 import           Cardano.Node.Orphans ()
 import           Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny)
 import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.HardFork ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Default.Class as DefaultClass
+import           Data.Functor.Identity (Identity (..))
+import           Data.Int
+import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import           Data.Word
+
 --
 -- Conway genesis
 --
 
+-- The Conway genesis values are not going to be ready in time for
+-- cardano-node 9.0. Therefore when the conway genesis file is not set
+-- we will restrict the max protocol version to 8 and use a dummy conway
+-- genesis value. This will prevent an unintentional hardfork.
+readGenesisMaybe :: Maybe GenesisFile
+                 -> Maybe GenesisHash
+                 -> ExceptT GenesisReadError IO
+                            (Conway.ConwayGenesis StandardCrypto, GenesisHash)
+readGenesisMaybe (Just genFp) mHash = readGenesis genFp mHash
+readGenesisMaybe Nothing _ = do
+  case L.mkCostModelsLenient plutusV3CostModel >>= Map.lookup L.PlutusV3 . L.costModelsValid of
+    Nothing -> error "readGenesisMaybe: missing PlutusV3 cost model in default cost models."
+    Just cm -> do
+      let protocolVerson = L.natVersion @8 -- For empty conway genesis we stay in Babbage (protocol version 8)
+          conwayGenesis = emptyConwayGenesis cm
+          genesisHash = GenesisHash (Crypto.hashWith id $ LB.toStrict $ L.serialize protocolVerson conwayGenesis)
+      return (conwayGenesis, genesisHash)
+
+plutusV3CostModel :: Map Word8 [Int64]
+plutusV3CostModel = Map.singleton 2 plutusV3ExampleValues
+
+plutusV3ExampleValues :: [Int64]
+plutusV3ExampleValues =
+  [ 205665, 812, 1, 1, 1000, 571, 0, 1, 1000, 24177, 4, 1, 1000, 32, 117366, 10475
+  , 4, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 23000, 100, 100
+  , 100, 23000, 100, 19537, 32, 175354, 32, 46417, 4, 221973, 511, 0, 1, 89141, 32
+  , 497525, 14068, 4, 2, 196500, 453240, 220, 0, 1, 1, 1000, 28662, 4, 2, 245000
+  , 216773, 62, 1, 1060367, 12586, 1, 208512, 421, 1, 187000, 1000, 52998, 1, 80436
+  , 32, 43249, 32, 1000, 32, 80556, 1, 57667, 4, 1000, 10, 197145, 156, 1, 197145
+  , 156, 1, 204924, 473, 1, 208896, 511, 1, 52467, 32, 64832, 32, 65493, 32, 22558
+  , 32, 16563, 32, 76511, 32, 196500, 453240, 220, 0, 1, 1, 69522, 11687, 0, 1, 60091
+  , 32, 196500, 453240, 220, 0, 1, 1, 196500, 453240, 220, 0, 1, 1, 1159724, 392670
+  , 0, 2, 806990, 30482, 4, 1927926, 82523, 4, 265318, 0, 4, 0, 85931, 32, 205665, 812
+  , 1, 1, 41182, 32, 212342, 32, 31220, 32, 32696, 32, 43357, 32, 32247, 32, 38314, 32
+  , 35190005, 10, 57996947, 18975, 10, 39121781, 32260, 10, 23000, 100, 23000, 100, 832808
+  , 18, 3209094, 6, 331451, 1, 65990684, 23097, 18, 114242, 18, 94393407, 87060, 18, 16420089
+  , 18, 2145798, 36, 3795345, 12, 889023, 1, 204237282, 23271, 36, 129165, 36, 189977790
+  , 85902, 36, 33012864, 36, 388443360, 1, 401885761, 72, 2331379, 72, 1927926, 82523
+  , 4, 117366, 10475, 4, 1292075, 24469, 74, 0, 1, 936157, 49601, 237, 0, 1
+  ]
+emptyConwayGenesis :: L.CostModel -> ConwayGenesis StandardCrypto
+emptyConwayGenesis cm =
+  let upgradePParamsDef :: (UpgradeConwayPParams Identity) -- TODO: need to define values
+  -- the default instance is for StrictMaybe
+      upgradePParamsDef =  UpgradeConwayPParams
+                            { ucppPoolVotingThresholds = DefaultClass.def
+                            , ucppDRepVotingThresholds = DefaultClass.def
+                            , ucppCommitteeMinSize = 0
+                            , ucppCommitteeMaxTermLength = EpochInterval 0
+                            , ucppGovActionLifetime = EpochInterval 0
+                            , ucppGovActionDeposit = 0
+                            , ucppDRepDeposit = 0
+                            , ucppDRepActivity = EpochInterval 0
+                            , ucppMinFeeRefScriptCostPerByte = minBound
+                            , ucppPlutusV3CostModel = cm
+                            }
+  in ConwayGenesis { cgUpgradePParams = upgradePParamsDef
+                   , cgConstitution = DefaultClass.def
+                   , cgCommittee = DefaultClass.def
+                   , cgDelegs = mempty
+                   , cgInitialDReps = mempty
+                   }
+
+
 readGenesis :: GenesisFile
             -> Maybe GenesisHash
             -> ExceptT GenesisReadError IO

cardano-node/src/Cardano/Node/Types.hs

@@ -150,7 +150,10 @@ data NodeAlonzoProtocolConfiguration =
 
 data NodeConwayProtocolConfiguration =
      NodeConwayProtocolConfiguration {
-       npcConwayGenesisFile     :: !GenesisFile
+       npcConwayGenesisFile     :: !(Maybe GenesisFile)
+       -- ^ If no conway genesis file is provided, we want
+       -- to enforce a maximum protocol version of 8 to avoid
+       -- a permanent hard fork.
      , npcConwayGenesisFileHash :: !(Maybe GenesisHash)
      }
   deriving (Eq, Show)

cardano-node/test/Test/Cardano/Node/POM.hs

@@ -75,7 +75,7 @@ testNodeAlonzoProtocolConfiguration =
 testNodeConwayProtocolConfiguration :: NodeConwayProtocolConfiguration
 testNodeConwayProtocolConfiguration =
   NodeConwayProtocolConfiguration
-    { npcConwayGenesisFile      = GenesisFile "dummmy-genesis-file"
+    { npcConwayGenesisFile      = Just $ GenesisFile "dummmy-genesis-file"
     , npcConwayGenesisFileHash  = Nothing
     }