Prevent updating protocol version with PParamUpdate

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -117,6 +117,7 @@ import Cardano.Ledger.Shelley.PParams (
   emptyPPPUpdates,
   shelleyCommonPParamsHKDPairs,
   shelleyCommonPParamsHKDPairsV6,
+  shelleyCommonPParamsHKDPairsV8,
  )
 import Cardano.Ledger.TreeDiff (ToExpr (..))
 import Cardano.Ledger.Val (Val (..))
@@ -626,6 +627,7 @@ alonzoPParamsHKDPairs ::
   [(Key, HKD f Aeson.Value)]
 alonzoPParamsHKDPairs px pp =
   alonzoCommonPParamsHKDPairs px pp
+    ++ shelleyCommonPParamsHKDPairsV8 px pp
     ++ shelleyCommonPParamsHKDPairsV6 px pp
     ++ [("lovelacePerUTxOWord", hkdMap px (toJSON @CoinPerWord) (pp ^. hkdCoinsPerUTxOWordL @_ @f))]
 

eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs

@@ -313,7 +313,7 @@ instance Era era => FromCBOR (BabbagePParams Identity era) where
   fromCBOR = fromEraCBOR @era
 
 instance
-  (PParamsHKD Identity era ~ BabbagePParams Identity era, BabbageEraPParams era) =>
+  (PParamsHKD Identity era ~ BabbagePParams Identity era, BabbageEraPParams era, ProtVerAtMost era 8) =>
   ToJSON (BabbagePParams Identity era)
   where
   toJSON = object . babbagePParamsPairs
@@ -463,7 +463,7 @@ instance Era era => FromCBOR (BabbagePParams StrictMaybe era) where
   fromCBOR = fromEraCBOR @era
 
 instance
-  (PParamsHKD StrictMaybe era ~ BabbagePParams StrictMaybe era, BabbageEraPParams era) =>
+  (PParamsHKD StrictMaybe era ~ BabbagePParams StrictMaybe era, BabbageEraPParams era, ProtVerAtMost era 8) =>
   ToJSON (BabbagePParams StrictMaybe era)
   where
   toJSON = object . babbagePParamsUpdatePairs

eras/conway/impl/CHANGELOG.md

@@ -18,6 +18,7 @@
 * Add `conwayWitsVKeyNeeded`
 * Add  `ConwayEraPParams era` constraint to `isCommitteeVotingAllowed` and `votingCommitteeThreshold`
 * Switch to using `AlonzoEraUTxO` in rules
+* Change `cppProtocolVersion` to a `HKDNoUpdate` field
 
 ## 1.9.0.0
 

eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs

@@ -67,7 +67,7 @@ import Cardano.Ledger.Coin (Coin (Coin))
 import Cardano.Ledger.Conway.Core hiding (Value)
 import Cardano.Ledger.Conway.Era (ConwayEra)
 import Cardano.Ledger.Crypto
-import Cardano.Ledger.HKD (HKD, HKDFunctor (..))
+import Cardano.Ledger.HKD (HKD, HKDFunctor (..), HKDNoUpdate, NoUpdate (..))
 import Cardano.Ledger.TreeDiff (ToExpr)
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData)
@@ -119,7 +119,7 @@ data ConwayPParams f era = ConwayPParams
   -- ^ Monetary expansion
   , cppTau :: !(HKD f UnitInterval)
   -- ^ Treasury expansion
-  , cppProtocolVersion :: !(HKD f ProtVer)
+  , cppProtocolVersion :: !(HKDNoUpdate f ProtVer)
   -- ^ Protocol version
   , cppMinPoolCost :: !(HKD f Coin)
   -- ^ Minimum Stake Pool Cost
@@ -293,10 +293,12 @@ instance Crypto c => EraPParams (ConwayEra c) where
   hkdA0L = lens cppA0 $ \pp x -> pp {cppA0 = x}
   hkdRhoL = lens cppRho $ \pp x -> pp {cppRho = x}
   hkdTauL = lens cppTau $ \pp x -> pp {cppTau = x}
-  hkdProtocolVersionL = lens cppProtocolVersion $ \pp x -> pp {cppProtocolVersion = x}
+  hkdProtocolVersionL = notSupportedInThisEraL
   hkdMinPoolCostL = lens cppMinPoolCost $ \pp x -> pp {cppMinPoolCost = x}
+  ppProtocolVersionL = ppLens . lens cppProtocolVersion (\pp x -> pp {cppProtocolVersion = x})
 
   ppDG = to (const minBound)
+  ppuProtocolVersionL = notSupportedInThisEraL
   hkdDL = notSupportedInThisEraL
   hkdExtraEntropyL = notSupportedInThisEraL
   hkdMinUTxOValueL = notSupportedInThisEraL
@@ -531,7 +533,7 @@ emptyConwayPParamsUpdate =
     , cppA0 = SNothing
     , cppRho = SNothing
     , cppTau = SNothing
-    , cppProtocolVersion = SNothing
+    , cppProtocolVersion = NoUpdate
     , cppMinPoolCost = SNothing
     , cppCoinsPerUTxOByte = SNothing
     , cppCostModels = SNothing
@@ -569,7 +571,7 @@ encodePParamsUpdate ppup =
     !> omitStrictMaybe 9 (cppA0 ppup) encCBOR
     !> omitStrictMaybe 10 (cppRho ppup) encCBOR
     !> omitStrictMaybe 11 (cppTau ppup) encCBOR
-    !> omitStrictMaybe 14 SNothing encCBOR
+    !> OmitC NoUpdate
     !> omitStrictMaybe 16 (cppMinPoolCost ppup) encCBOR
     !> omitStrictMaybe 17 (cppCoinsPerUTxOByte ppup) encCBOR
     !> omitStrictMaybe 18 (cppCostModels ppup) encCBOR
@@ -726,6 +728,7 @@ instance FromJSON (UpgradeConwayPParams Identity) where
 
 upgradeConwayPParams ::
   forall f c.
+  HKDFunctor f =>
   UpgradeConwayPParams f ->
   PParamsHKD f (BabbageEra c) ->
   ConwayPParams f (ConwayEra c)
@@ -743,7 +746,7 @@ upgradeConwayPParams UpgradeConwayPParams {..} BabbagePParams {..} =
     , cppA0 = bppA0
     , cppRho = bppRho
     , cppTau = bppTau
-    , cppProtocolVersion = bppProtocolVersion
+    , cppProtocolVersion = toNoUpdate @f @ProtVer bppProtocolVersion
     , cppMinPoolCost = bppMinPoolCost
     , cppCoinsPerUTxOByte = bppCoinsPerUTxOByte
     , cppCostModels = bppCostModels
@@ -766,6 +769,7 @@ upgradeConwayPParams UpgradeConwayPParams {..} BabbagePParams {..} =
 
 downgradeConwayPParams ::
   forall f c.
+  HKDFunctor f =>
   ConwayPParams f (ConwayEra c) ->
   PParamsHKD f (BabbageEra c)
 downgradeConwayPParams ConwayPParams {..} =
@@ -782,7 +786,7 @@ downgradeConwayPParams ConwayPParams {..} =
     , bppA0 = cppA0
     , bppRho = cppRho
     , bppTau = cppTau
-    , bppProtocolVersion = cppProtocolVersion
+    , bppProtocolVersion = fromNoUpdate @f @ProtVer cppProtocolVersion
     , bppMinPoolCost = cppMinPoolCost
     , bppCoinsPerUTxOByte = cppCoinsPerUTxOByte
     , bppCostModels = cppCostModels

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -52,6 +52,7 @@ import Cardano.Ledger.Conway.Rules
 import Cardano.Ledger.Conway.TxBody
 import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Crypto (Crypto)
+import Cardano.Ledger.HKD (NoUpdate (..))
 import Cardano.Ledger.Language (Language (..))
 import Control.State.Transition.Extended (STS (Event))
 import Data.Functor.Identity (Identity)
@@ -499,7 +500,7 @@ instance Era era => Arbitrary (ConwayPParams StrictMaybe era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> pure SNothing
+      <*> pure NoUpdate
       <*> arbitrary
       <*> arbitrary
       <*> (fmap unFlexibleCostModels <$> arbitrary)

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.7.0.0
 
+* Add `shelleyCommonPParamsHKDPairsV8`
 * Add `ToExpr` instances for:
   * `ShelleyPoolPredFailure`
   * `ShelleyUtxowPredFailure`

eras/shelley/impl/src/Cardano/Ledger/Chain.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}

eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs

@@ -31,6 +31,7 @@ module Cardano.Ledger.Shelley.PParams (
   -- * JSON helpers
   shelleyCommonPParamsHKDPairs,
   shelleyCommonPParamsHKDPairsV6,
+  shelleyCommonPParamsHKDPairsV8,
 
   -- * Deprecated
   updatePParams,
@@ -240,6 +241,7 @@ instance
   , PParamsHKD Identity era ~ ShelleyPParams Identity era
   , ProtVerAtMost era 4
   , ProtVerAtMost era 6
+  , ProtVerAtMost era 8
   ) =>
   ToJSON (ShelleyPParams Identity era)
   where
@@ -248,7 +250,7 @@ instance
 
 shelleyPParamsPairs ::
   forall era a.
-  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, KeyValue a) =>
+  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, KeyValue a) =>
   PParamsHKD Identity era ->
   [a]
 shelleyPParamsPairs pp =
@@ -416,6 +418,7 @@ instance
   , PParamsHKD StrictMaybe era ~ ShelleyPParams StrictMaybe era
   , ProtVerAtMost era 4
   , ProtVerAtMost era 6
+  , ProtVerAtMost era 8
   ) =>
   ToJSON (ShelleyPParams StrictMaybe era)
   where
@@ -424,7 +427,7 @@ instance
 
 shelleyPParamsUpdatePairs ::
   forall era a.
-  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, KeyValue a) =>
+  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, KeyValue a) =>
   PParamsHKD StrictMaybe era ->
   [a]
 shelleyPParamsUpdatePairs pp =
@@ -434,13 +437,14 @@ shelleyPParamsUpdatePairs pp =
 
 shelleyPParamsHKDPairs ::
   forall f era.
-  (HKDFunctor f, EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
+  (HKDFunctor f, EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8) =>
   Proxy f ->
   PParamsHKD f era ->
   [(Key, HKD f Aeson.Value)]
 shelleyPParamsHKDPairs px pp =
   shelleyCommonPParamsHKDPairs px pp
     ++ shelleyCommonPParamsHKDPairsV6 px pp
+    ++ shelleyCommonPParamsHKDPairsV8 px pp
     ++ [("minUTxOValue", hkdMap px (toJSON @Coin) (pp ^. hkdMinUTxOValueL @era @f))]
 
 -- | These are the fields that are common only up to major protocol version 6
@@ -455,6 +459,16 @@ shelleyCommonPParamsHKDPairsV6 px pp =
   , ("extraEntropy", hkdMap px (toJSON @Nonce) (pp ^. hkdExtraEntropyL @era @f))
   ]
 
+shelleyCommonPParamsHKDPairsV8 ::
+  forall f era.
+  (HKDFunctor f, EraPParams era, ProtVerAtMost era 8) =>
+  Proxy f ->
+  PParamsHKD f era ->
+  [(Key, HKD f Aeson.Value)]
+shelleyCommonPParamsHKDPairsV8 px pp =
+  [ ("protocolVersion", hkdMap px (toJSON @ProtVer) (pp ^. hkdProtocolVersionL @era @f))
+  ]
+
 -- | These are the fields that are common across all eras
 shelleyCommonPParamsHKDPairs ::
   forall f era.
@@ -475,7 +489,6 @@ shelleyCommonPParamsHKDPairs px pp =
   , ("a0", hkdMap px (toJSON @NonNegativeInterval) (pp ^. hkdA0L @era @f))
   , ("rho", hkdMap px (toJSON @UnitInterval) (pp ^. hkdRhoL @era @f))
   , ("tau", hkdMap px (toJSON @UnitInterval) (pp ^. hkdTauL @era @f))
-  , ("protocolVersion", hkdMap px (toJSON @ProtVer) (pp ^. hkdProtocolVersionL @era @f))
   , ("minPoolCost", hkdMap px (toJSON @Coin) (pp ^. hkdMinPoolCostL @era @f))
   ]
 

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs

@@ -66,6 +66,7 @@ instance NoThunks (ShelleyNewppPredFailure era)
 instance
   ( EraGov era
   , GovState era ~ ShelleyGovState era
+  , ProtVerAtMost era 8
   ) =>
   STS (ShelleyNEWPP era)
   where
@@ -83,6 +84,7 @@ newPpTransition ::
   forall era.
   ( GovState era ~ ShelleyGovState era
   , EraGov era
+  , ProtVerAtMost era 8
   ) =>
   TransitionRule (ShelleyNEWPP era)
 newPpTransition = do
@@ -114,6 +116,7 @@ newPpTransition = do
 updatePpup ::
   ( EraPParams era
   , GovState era ~ ShelleyGovState era
+  , ProtVerAtMost era 8
   ) =>
   GovState era ->
   PParams era ->

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs

@@ -117,7 +117,7 @@ instance NFData (ShelleyPpupPredFailure era)
 
 newtype PpupEvent era = NewEpoch EpochNo
 
-instance EraPParams era => STS (ShelleyPPUP era) where
+instance (EraPParams era, ProtVerAtMost era 8) => STS (ShelleyPPUP era) where
   type State (ShelleyPPUP era) = ShelleyGovState era
   type Signal (ShelleyPPUP era) = Maybe (Update era)
   type Environment (ShelleyPPUP era) = PpupEnv era
@@ -157,7 +157,7 @@ instance Era era => DecCBOR (ShelleyPpupPredFailure era) where
         pure (2, PVCannotFollowPPUP p)
       k -> invalidKey k
 
-ppupTransitionNonEmpty :: EraPParams era => TransitionRule (ShelleyPPUP era)
+ppupTransitionNonEmpty :: (EraPParams era, ProtVerAtMost era 8) => TransitionRule (ShelleyPPUP era)
 ppupTransitionNonEmpty = do
   TRC
     ( PPUPEnv slot pp (GenDelegs _genDelegs)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs

@@ -78,6 +78,7 @@ instance
   ( EraGov era
   , Default (PParams era)
   , GovState era ~ ShelleyGovState era
+  , ProtVerAtMost era 8
   ) =>
   STS (ShelleyUPEC era)
   where

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs

@@ -233,7 +233,7 @@ genM gen = frequency [(1, SJust <$> gen), (2, pure SNothing)]
 -- | This is only good in the Shelley Era, used to define the genShelleyEraPParamsUpdate method for (EraGen (ShelleyEra c))
 genShelleyPParamsUpdate ::
   forall era.
-  (ProtVerAtMost era 4, ProtVerAtMost era 6, EraPParams era) =>
+  (ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, EraPParams era) =>
   Constants ->
   PParams era ->
   Gen (PParamsUpdate era)

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,12 @@
 
 ## 1.8.0.0
 
+* Add `NoUpdate`, `HKDNoUpdate`
+* Add `toNoUpdate` and `fromNoUpdate` methods to `HKDFunctor`
+* Add `Updatable` instance for `NoUpdate`
+* Change functions to methods of `EraPParams`:
+  * `ppProtocolVersionL`
+  * `ppuProtocolVersionL`
 * Add `Generic` instance for `AuxiliaryDataHash`
 * Add `ToExpr` instances for:
   * `CompactAddr`

libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs

@@ -39,7 +39,6 @@ module Cardano.Ledger.Core.PParams (
   ppTauL,
   ppDL,
   ppExtraEntropyL,
-  ppProtocolVersionL,
   ppMinUTxOValueL,
   ppMinPoolCostL,
 
@@ -58,7 +57,6 @@ module Cardano.Ledger.Core.PParams (
   ppuTauL,
   ppuDL,
   ppuExtraEntropyL,
-  ppuProtocolVersionL,
   ppuMinUTxOValueL,
   ppuMinPoolCostL,
 
@@ -85,7 +83,7 @@ import Cardano.Ledger.BaseTypes (
 import Cardano.Ledger.Binary (DecCBOR, EncCBOR, FromCBOR, ToCBOR)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core.Era (Era (..), PreviousEra, ProtVerAtMost)
-import Cardano.Ledger.HKD (HKD, HKDFunctor)
+import Cardano.Ledger.HKD (HKD, HKDFunctor (..), NoUpdate (..))
 import Control.DeepSeq (NFData)
 import Control.Monad.Identity (Identity)
 import Data.Aeson (FromJSON, ToJSON)
@@ -208,6 +206,9 @@ instance Updatable (K1 t x a) (K1 t (StrictMaybe x) u) where
     SJust x -> x
     SNothing -> x'
 
+instance Updatable (K1 t x a) (K1 t (NoUpdate x) u) where
+  applyUpdate (K1 x) (K1 NoUpdate) = K1 x
+
 class
   ( Era era
   , Eq (PParamsHKD Identity era)
@@ -327,7 +328,15 @@ class
   hkdExtraEntropyL :: (HKDFunctor f, ProtVerAtMost era 6) => Lens' (PParamsHKD f era) (HKD f Nonce)
 
   -- | Protocol version
-  hkdProtocolVersionL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f ProtVer)
+  hkdProtocolVersionL :: (HKDFunctor f, ProtVerAtMost era 8) => Lens' (PParamsHKD f era) (HKD f ProtVer)
+
+  ppProtocolVersionL :: EraPParams era => Lens' (PParams era) ProtVer
+  default ppProtocolVersionL :: ProtVerAtMost era 8 => Lens' (PParams era) ProtVer
+  ppProtocolVersionL = ppLens . hkdProtocolVersionL @era @Identity
+
+  -- | PParamsUpdate Protocol version
+  ppuProtocolVersionL :: (ProtVerAtMost era 8, EraPParams era) => Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
+  ppuProtocolVersionL = ppuLens . hkdProtocolVersionL @era @StrictMaybe
 
   -- | Minimum UTxO value
   hkdMinUTxOValueL :: HKDFunctor f => ProtVerAtMost era 4 => Lens' (PParamsHKD f era) (HKD f Coin)
@@ -405,10 +414,6 @@ ppDL = ppLens . hkdDL @era @Identity
 ppExtraEntropyL :: forall era. (EraPParams era, ProtVerAtMost era 6) => Lens' (PParams era) Nonce
 ppExtraEntropyL = ppLens . hkdExtraEntropyL @era @Identity
 
--- | Protocol version
-ppProtocolVersionL :: forall era. EraPParams era => Lens' (PParams era) ProtVer
-ppProtocolVersionL = ppLens . hkdProtocolVersionL @era @Identity
-
 -- | Minimum UTxO value
 ppMinUTxOValueL :: forall era. (EraPParams era, ProtVerAtMost era 4) => Lens' (PParams era) Coin
 ppMinUTxOValueL = ppLens . hkdMinUTxOValueL @era @Identity
@@ -481,10 +486,6 @@ ppuExtraEntropyL ::
   Lens' (PParamsUpdate era) (StrictMaybe Nonce)
 ppuExtraEntropyL = ppuLens . hkdExtraEntropyL @era @StrictMaybe
 
--- | Protocol version
-ppuProtocolVersionL :: forall era. EraPParams era => Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
-ppuProtocolVersionL = ppuLens . hkdProtocolVersionL @era @StrictMaybe
-
 -- | Minimum UTxO value
 ppuMinUTxOValueL ::
   forall era.