Merge pull request #5098 from IntersectMBO/aniketd/hardfork-triggers

Hardfork triggers

Author: aniketd

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 #if __GLASGOW_HASKELL__ >= 908
@@ -13,8 +14,10 @@ module Cardano.Ledger.Alonzo.Era (
   AlonzoUTXOW,
   AlonzoBBODY,
   AlonzoLEDGER,
+  hardforkConwayTranslateUpperBoundForPlutusScripts,
 ) where
 
+import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion)
 import Cardano.Ledger.Internal.Era (AlonzoEra)
 import Cardano.Ledger.Mary (MaryEra, MaryValue)
 import Cardano.Ledger.Shelley.Core
@@ -90,3 +93,8 @@ type instance EraRule "TICK" AlonzoEra = ShelleyTICK AlonzoEra
 type instance EraRule "TICKF" AlonzoEra = ShelleyTICKF AlonzoEra
 
 type instance EraRule "UPEC" AlonzoEra = ShelleyUPEC AlonzoEra
+
+-- | Starting with protocol version 9, we translate the upper bound of validity
+-- interval correctly for Plutus scripts.
+hardforkConwayTranslateUpperBoundForPlutusScripts :: ProtVer -> Bool
+hardforkConwayTranslateUpperBoundForPlutusScripts pv = pvMajor pv > natVersion @8

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs

@@ -46,7 +46,7 @@ module Cardano.Ledger.Alonzo.Plutus.TxInfo (
 
 import Cardano.Crypto.Hash.Class (hashToBytes)
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Era (AlonzoEra)
+import Cardano.Ledger.Alonzo.Era (AlonzoEra, hardforkConwayTranslateUpperBoundForPlutusScripts)
 import Cardano.Ledger.Alonzo.Plutus.Context
 import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..), PlutusScript (..), toAsItem)
 import Cardano.Ledger.Alonzo.TxWits (unTxDatsL)
@@ -77,7 +77,6 @@ import Cardano.Ledger.Plutus.Language (
 import Cardano.Ledger.Plutus.TxInfo
 import Cardano.Ledger.PoolParams (PoolParams (..))
 import Cardano.Ledger.Rules.ValidationMode (Inject (..))
-import qualified Cardano.Ledger.Shelley.HardForks as HardForks
 import Cardano.Ledger.State (UTxO (..))
 import Cardano.Ledger.TxIn (TxIn (..), txInToText)
 import Cardano.Ledger.Val (zero)
@@ -231,7 +230,7 @@ transValidityInterval _ protVer epochInfo systemStart = \case
   ValidityInterval SNothing (SJust i) -> do
     t <- transSlotToPOSIXTime i
     pure $
-      if HardForks.translateUpperBoundForPlutusScripts protVer
+      if hardforkConwayTranslateUpperBoundForPlutusScripts protVer
         then
           PV1.Interval
             (PV1.LowerBound PV1.NegInf True)

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 1.20.0.0
 
+- Move some hard-fork triggers and export them from `Cardano.Ledger.Conway` module.
+  - `bootstrapPhase` to `hardforkConwayBootstrapPhase`.
+  - `disallowUnelectedCommitteeFromVoting` to `hardforkConwayDisallowUnelectedCommitteeFromVoting`.
 - Add `UnelectedCommitteeVoters` to `ConwayGovPredFailure` #5091
 - Change the type of `authorizedELectedCommitteeCredentials` to
   `StrictMaybe (Committee era) -> CommitteeState era -> Set.Set (Credential 'HotCommitteeRole)` #5091

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

@@ -8,10 +8,16 @@
 module Cardano.Ledger.Conway (
   Conway,
   ConwayEra,
+  hardforkConwayBootstrapPhase,
+  hardforkConwayDisallowUnelectedCommitteeFromVoting,
 ) where
 
 import Cardano.Ledger.Babbage.TxBody ()
-import Cardano.Ledger.Conway.Era (ConwayEra)
+import Cardano.Ledger.Conway.Era (
+  ConwayEra,
+  hardforkConwayBootstrapPhase,
+  hardforkConwayDisallowUnelectedCommitteeFromVoting,
+ )
 import Cardano.Ledger.Conway.Governance (RunConwayRatify (..))
 import Cardano.Ledger.Conway.Rules ()
 import Cardano.Ledger.Conway.State ()

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 #if __GLASGOW_HASKELL__ >= 908
@@ -25,9 +26,12 @@ module Cardano.Ledger.Conway.Era (
   ConwayTICKF,
   ConwayLEDGER,
   ConwayRATIFY,
+  hardforkConwayBootstrapPhase,
+  hardforkConwayDisallowUnelectedCommitteeFromVoting,
 ) where
 
 import Cardano.Ledger.Babbage (BabbageEra)
+import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Internal.Era (ConwayEra)
 import Cardano.Ledger.Mary.Value (MaryValue)
@@ -170,4 +174,11 @@ type instance EraRule "TICK" ConwayEra = ShelleyTICK ConwayEra
 
 type instance EraRule "POOL" ConwayEra = ShelleyPOOL ConwayEra
 
--- =================================================
+-- | Bootstrap phase
+hardforkConwayBootstrapPhase :: ProtVer -> Bool
+hardforkConwayBootstrapPhase pv = pvMajor pv == natVersion @9
+
+-- | Starting with protocol version 11, we do not allow unelected committee
+-- members to submit votes.
+hardforkConwayDisallowUnelectedCommitteeFromVoting :: ProtVer -> Bool
+hardforkConwayDisallowUnelectedCommitteeFromVoting pv = pvMajor pv > natVersion @10

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs

@@ -1,11 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -92,6 +90,7 @@ import Cardano.Ledger.Binary.Coders (
   (<!),
  )
 import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Conway.Era (hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Conway.Governance.Procedures
 import Cardano.Ledger.Conway.PParams (
   ConwayEraPParams (..),
@@ -112,7 +111,6 @@ import Cardano.Ledger.Conway.State
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.PoolParams (PoolParams)
-import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
 import Cardano.Ledger.Shelley.LedgerState (
   epochStateStakeDistrL,
   epochStateUMapL,
@@ -479,7 +477,7 @@ votingCommitteeThresholdInternal currentEpoch pp committee (CommitteeState hotKe
         -- if the committee size is smaller than the minimum given in PParams,
         -- we treat it as if we had no committee
         SJust t
-          | HF.bootstrapPhase (pp ^. ppProtocolVersionL)
+          | hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL)
               || activeCommitteeSize >= minSize ->
               VotingThreshold t
         _ -> NoVotingThreshold
@@ -531,7 +529,7 @@ votingDRepThresholdInternal pp isElectedCommittee action =
         , dvtHardForkInitiation
         , dvtTreasuryWithdrawal
         } -- We reset all (except InfoAction) DRep thresholds to 0 during bootstrap phase
-          | HF.bootstrapPhase (pp ^. ppProtocolVersionL) = def
+          | hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL) = def
           | otherwise = pp ^. ppDRepVotingThresholdsL
    in case action of
         NoConfidence {} -> VotingThreshold dvtMotionNoConfidence

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

@@ -16,7 +16,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -115,7 +114,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Coin (Coin (Coin))
-import Cardano.Ledger.Conway.Era (ConwayEra)
+import Cardano.Ledger.Conway.Era (ConwayEra, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (
   HKDApplicative (hkdLiftA2),
@@ -132,7 +131,6 @@ import Cardano.Ledger.Plutus.CostModels (
  )
 import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
 import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
-import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
 import Cardano.Ledger.Shelley.PParams
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData (..), rwhnf)
@@ -888,7 +886,7 @@ instance ConwayEraPParams ConwayEra where
         isValid (/= zero) ppuPoolDepositL
       , isValid (/= zero) ppuGovActionDepositL
       , isValid (/= zero) ppuDRepDepositL
-      , bootstrapPhase pv
+      , hardforkConwayBootstrapPhase pv
           || isValid ((/= zero) . unCoinPerByte) ppuCoinsPerUTxOByteL
       , ppu /= emptyPParamsUpdate
       ]

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -35,7 +34,7 @@ import Cardano.Ledger.Binary.Coders (
  )
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Conway.Core
-import Cardano.Ledger.Conway.Era (ConwayDELEG, ConwayEra)
+import Cardano.Ledger.Conway.Era (ConwayDELEG, ConwayEra, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Conway.State (
   ConwayEraCertState (..),
   vsDRepsL,
@@ -47,7 +46,6 @@ import Cardano.Ledger.Conway.TxCert (
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.DRep (DRep (..), DRepState (..))
 import Cardano.Ledger.PoolParams (PoolParams)
-import qualified Cardano.Ledger.Shelley.HardForks as HF
 import Cardano.Ledger.State (
   EraCertState (..),
   dsUnifiedL,
@@ -196,7 +194,7 @@ conwayDelegTransition = do
             DRepAlwaysNoConfidence -> pure ()
             DRepCredential targetDRep -> do
               let dReps = certState ^. certVStateL . vsDRepsL
-              unless (HF.bootstrapPhase (pp ^. ppProtocolVersionL)) $
+              unless (hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL)) $
                 targetDRep `Map.member` dReps ?! DelegateeDRepNotRegisteredDELEG targetDRep
        in \case
             DelegStake targetPool -> checkPoolRegistered targetPool

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -60,7 +60,12 @@ import Cardano.Ledger.Binary.Coders (
  )
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core (ppGovActionDepositL, ppGovActionLifetimeL)
-import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOV)
+import Cardano.Ledger.Conway.Era (
+  ConwayEra,
+  ConwayGOV,
+  hardforkConwayBootstrapPhase,
+  hardforkConwayDisallowUnelectedCommitteeFromVoting,
+ )
 import Cardano.Ledger.Conway.Governance (
   Committee,
   ConwayEraGov,
@@ -104,10 +109,6 @@ import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Rules.ValidationMode (Test, runTest)
-import qualified Cardano.Ledger.Shelley.HardForks as HF (
-  bootstrapPhase,
-  disallowUnelectedCommitteeFromVoting,
- )
 import Cardano.Ledger.Shelley.LedgerState (dsUnifiedL)
 import Cardano.Ledger.Shelley.PParams (pvCanFollow)
 import Cardano.Ledger.State (
@@ -387,7 +388,7 @@ checkBootstrapVotes ::
   [(Voter, GovActionState era)] ->
   Test (ConwayGovPredFailure era)
 checkBootstrapVotes pp votes
-  | HF.bootstrapPhase (pp ^. ppProtocolVersionL) =
+  | hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL) =
       checkDisallowedVotes votes DisallowedVotesDuringBootstrap $ \gas ->
         \case
           DRepVoter {} | gasAction gas == InfoAction -> True
@@ -436,7 +437,7 @@ checkBootstrapProposal ::
   ProposalProcedure era ->
   Test (ConwayGovPredFailure era)
 checkBootstrapProposal pp proposal@ProposalProcedure {pProcGovAction}
-  | HF.bootstrapPhase (pp ^. ppProtocolVersionL) =
+  | hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL) =
       failureUnless (isBootstrapAction pProcGovAction) $ DisallowedProposalDuringBootstrap proposal
   | otherwise = pure ()
 
@@ -474,7 +475,7 @@ govTransition = do
 
   expectedNetworkId <- liftSTS $ asks networkId
 
-  when (HF.disallowUnelectedCommitteeFromVoting $ pp ^. ppProtocolVersionL) $
+  when (hardforkConwayDisallowUnelectedCommitteeFromVoting $ pp ^. ppProtocolVersionL) $
     failOnNonEmpty
       (unelectedCommitteeVoters committee committeeState gsVotingProcedures)
       UnelectedCommitteeVoters
@@ -502,7 +503,7 @@ govTransition = do
         -- PParamsUpdate well-formedness check
         runTest $ actionWellFormed (pp ^. ppProtocolVersionL) pProcGovAction
 
-        unless (HF.bootstrapPhase $ pp ^. ppProtocolVersionL) $ do
+        unless (hardforkConwayBootstrapPhase $ pp ^. ppProtocolVersionL) $ do
           let refundAddress = proposal ^. pProcReturnAddrL
               govAction = proposal ^. pProcGovActionL
           UMap.member' (raCredential refundAddress) (certDState ^. dsUnifiedL)
@@ -541,7 +542,7 @@ govTransition = do
             -- Policy check
             runTest $ checkPolicy @era constitutionPolicy proposalPolicy
 
-            unless (HF.bootstrapPhase (pp ^. ppProtocolVersionL)) $
+            unless (hardforkConwayBootstrapPhase $ pp ^. ppProtocolVersionL) $
               -- The sum of all withdrawals must be positive
               F.fold wdrls /= mempty ?! ZeroTreasuryWithdrawals pProcGovAction
           UpdateCommittee _mPrevGovActionId membersToRemove membersToAdd _qrm -> do

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs

@@ -38,7 +38,7 @@ import Cardano.Ledger.Binary (
 import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Conway.Core
-import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT)
+import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT, hardforkConwayBootstrapPhase)
 import Cardano.Ledger.Conway.Governance (
   Committee (..),
   GovAction (..),
@@ -58,7 +58,6 @@ import Cardano.Ledger.Conway.State (
 import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.DRep (DRepState (..), drepAnchorL, drepDepositL, drepExpiryL)
-import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
 import Cardano.Ledger.State (
   CommitteeAuthorization (..),
   CommitteeState (..),
@@ -291,7 +290,7 @@ computeDRepExpiryVersioned ::
 computeDRepExpiryVersioned pp currentEpoch numDormantEpochs
   -- Starting with version 10, we correctly take into account the number of dormant epochs
   -- when registering a drep
-  | HF.bootstrapPhase (pp ^. ppProtocolVersionL) =
+  | hardforkConwayBootstrapPhase (pp ^. ppProtocolVersionL) =
       addEpochInterval currentEpoch (pp ^. ppDRepActivityL)
   | otherwise =
       computeDRepExpiry (pp ^. ppDRepActivityL) currentEpoch numDormantEpochs