Merge pull request #3670 from input-output-hk/td/validate-prev-govid

Validate previously enacted govAction

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## 1.8.0.0
 
+* Add `PrevGovActionIds`
+* Change `EnactState` to add `ensPrevGovActionIds`
+* Add  `ensPrevGovActionIdsL`, `ensPrevPParamUpdateL`, `ensPrevHardForkL` `ensPrevCommitteeL`, `ensPrevConstitutionL`
+* Add `EnactSignal` and the signal of `Enact` to it
 * Remove `rsFuture` from `RatifyState`
 * Add to `GovActionsState`:
   * `curGovActionsState`

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

@@ -27,6 +27,7 @@ module Cardano.Ledger.Conway.Governance (
   GovActionIx (..),
   GovActionId (..),
   GovActionPurpose (..),
+  PrevGovActionIds (..),
   PrevGovActionId (..),
   govActionIdToText,
   Voter (..),
@@ -44,7 +45,15 @@ module Cardano.Ledger.Conway.Governance (
   cgGovActionsStateL,
   cgEnactStateL,
   cgRatifyStateL,
+  ensCommitteeL,
   ensConstitutionL,
+  ensCurPParamsL,
+  ensPrevGovActionIdsL,
+  ensPrevPParamUpdateL,
+  ensPrevHardForkL,
+  ensPrevCommitteeL,
+  ensPrevConstitutionL,
+  ensProtVerL,
   rsEnactStateL,
   curPParamsConwayGovStateL,
   prevPParamsConwayGovStateL,
@@ -270,36 +279,124 @@ instance EraPParams era => ToCBOR (GovActionsState era) where
 instance EraPParams era => FromCBOR (GovActionsState era) where
   fromCBOR = fromEraCBOR @era
 
+data PrevGovActionIds era = PrevGovActionIds
+  { pgaPParamUpdate :: !(StrictMaybe (PrevGovActionId 'PParamUpdatePurpose (EraCrypto era)))
+  -- ^ The last enacted GovActionId for a protocol parameter update
+  , pgaHardFork :: !(StrictMaybe (PrevGovActionId 'HardForkPurpose (EraCrypto era)))
+  -- ^ The last enacted GovActionId for a hard fork
+  , pgaCommittee :: !(StrictMaybe (PrevGovActionId 'CommitteePurpose (EraCrypto era)))
+  -- ^ The last enacted GovActionId for a committee change or no confidence vote
+  , pgaConstitution :: !(StrictMaybe (PrevGovActionId 'ConstitutionPurpose (EraCrypto era)))
+  -- ^ The last enacted GovActionId for a new constitution
+  }
+  deriving (Eq, Show, Generic)
+
+instance NoThunks (PrevGovActionIds era)
+instance Era era => NFData (PrevGovActionIds era)
+instance Default (PrevGovActionIds era)
+
+instance Era era => DecCBOR (PrevGovActionIds era) where
+  decCBOR =
+    decode $
+      RecD PrevGovActionIds
+        <! From
+        <! From
+        <! From
+        <! From
+
+instance Era era => EncCBOR (PrevGovActionIds era) where
+  encCBOR PrevGovActionIds {..} =
+    encode $
+      Rec (PrevGovActionIds @era)
+        !> To pgaPParamUpdate
+        !> To pgaHardFork
+        !> To pgaCommittee
+        !> To pgaConstitution
+
+toPrevGovActionIdsParis :: (KeyValue a, Era era) => PrevGovActionIds era -> [a]
+toPrevGovActionIdsParis pga@(PrevGovActionIds _ _ _ _) =
+  let PrevGovActionIds {..} = pga
+   in [ "pgaPParamUpdate" .= pgaPParamUpdate
+      , "pgaHardFork" .= pgaHardFork
+      , "pgaCommittee" .= pgaCommittee
+      , "pgaConstitution" .= pgaConstitution
+      ]
+
+instance Era era => ToJSON (PrevGovActionIds era) where
+  toJSON = object . toPrevGovActionIdsParis
+  toEncoding = pairs . mconcat . toPrevGovActionIdsParis
+
+instance ToExpr (PrevGovActionIds era)
+
 data EnactState era = EnactState
   { ensCommittee :: !(StrictMaybe (Committee era))
   -- ^ Constitutional Committee
   , ensConstitution :: !(Constitution era)
-  -- ^ Hash of the Constitution
+  -- ^ Constitution
   , ensProtVer :: !ProtVer
   , ensPParams :: !(PParams era)
   , ensPrevPParams :: !(PParams era)
   , ensTreasury :: !Coin
   , ensWithdrawals :: !(Map (Credential 'Staking (EraCrypto era)) Coin)
+  , ensPrevGovActionIds :: !(PrevGovActionIds era)
+  -- ^ Last enacted GovAction Ids
   }
   deriving (Generic)
 
+ensCommitteeL :: Lens' (EnactState era) (StrictMaybe (Committee era))
+ensCommitteeL = lens ensCommittee (\x y -> x {ensCommittee = y})
+
 ensConstitutionL :: Lens' (EnactState era) (Constitution era)
 ensConstitutionL = lens ensConstitution (\x y -> x {ensConstitution = y})
 
+ensProtVerL :: Lens' (EnactState era) ProtVer
+ensProtVerL = lens ensProtVer (\x y -> x {ensProtVer = y})
+
 ensCurPParamsL :: Lens' (EnactState era) (PParams era)
 ensCurPParamsL = lens ensPParams (\es x -> es {ensPParams = x})
 
 ensPrevPParamsL :: Lens' (EnactState era) (PParams era)
 ensPrevPParamsL = lens ensPrevPParams (\es x -> es {ensPrevPParams = x})
 
+ensPrevGovActionIdsL :: Lens' (EnactState era) (PrevGovActionIds era)
+ensPrevGovActionIdsL = lens ensPrevGovActionIds (\es x -> es {ensPrevGovActionIds = x})
+
+ensPrevPParamUpdateL ::
+  Lens' (EnactState era) (StrictMaybe (PrevGovActionId 'PParamUpdatePurpose (EraCrypto era)))
+ensPrevPParamUpdateL =
+  lens
+    (pgaPParamUpdate . ensPrevGovActionIds)
+    (\es x -> es {ensPrevGovActionIds = (ensPrevGovActionIds es) {pgaPParamUpdate = x}})
+
+ensPrevHardForkL ::
+  Lens' (EnactState era) (StrictMaybe (PrevGovActionId 'HardForkPurpose (EraCrypto era)))
+ensPrevHardForkL =
+  lens
+    (pgaHardFork . ensPrevGovActionIds)
+    (\es x -> es {ensPrevGovActionIds = (ensPrevGovActionIds es) {pgaHardFork = x}})
+
+ensPrevCommitteeL ::
+  Lens' (EnactState era) (StrictMaybe (PrevGovActionId 'CommitteePurpose (EraCrypto era)))
+ensPrevCommitteeL =
+  lens
+    (pgaCommittee . ensPrevGovActionIds)
+    (\es x -> es {ensPrevGovActionIds = (ensPrevGovActionIds es) {pgaCommittee = x}})
+
+ensPrevConstitutionL ::
+  Lens' (EnactState era) (StrictMaybe (PrevGovActionId 'ConstitutionPurpose (EraCrypto era)))
+ensPrevConstitutionL =
+  lens
+    (pgaConstitution . ensPrevGovActionIds)
+    (\es x -> es {ensPrevGovActionIds = (ensPrevGovActionIds es) {pgaConstitution = x}})
+
 instance ToExpr (PParamsHKD Identity era) => ToExpr (EnactState era)
 
 instance EraPParams era => ToJSON (EnactState era) where
   toJSON = object . toEnactStatePairs
   toEncoding = pairs . mconcat . toEnactStatePairs
 
 toEnactStatePairs :: (KeyValue a, EraPParams era) => EnactState era -> [a]
-toEnactStatePairs cg@(EnactState _ _ _ _ _ _ _) =
+toEnactStatePairs cg@(EnactState _ _ _ _ _ _ _ _) =
   let EnactState {..} = cg
    in [ "committee" .= ensCommittee
       , "constitution" .= ensConstitution
@@ -308,6 +405,7 @@ toEnactStatePairs cg@(EnactState _ _ _ _ _ _ _) =
       , "prevPParams" .= ensPParams
       , "treasury" .= ensTreasury
       , "withdrawals" .= ensWithdrawals
+      , "prevGovActionIds" .= ensPrevGovActionIds
       ]
 
 deriving instance Eq (PParams era) => Eq (EnactState era)
@@ -324,6 +422,7 @@ instance EraPParams era => Default (EnactState era) where
       def
       (Coin 0)
       def
+      def
 
 instance EraPParams era => DecCBOR (EnactState era) where
   decCBOR =
@@ -336,6 +435,7 @@ instance EraPParams era => DecCBOR (EnactState era) where
         <! From
         <! From
         <! From
+        <! From
 
 instance EraPParams era => EncCBOR (EnactState era) where
   encCBOR EnactState {..} =
@@ -348,6 +448,7 @@ instance EraPParams era => EncCBOR (EnactState era) where
         !> To ensPrevPParams
         !> To ensTreasury
         !> To ensWithdrawals
+        !> To ensPrevGovActionIds
 
 instance EraPParams era => ToCBOR (EnactState era) where
   toCBOR = toEraCBOR @era

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

@@ -10,6 +10,7 @@
 
 module Cardano.Ledger.Conway.Rules.Enact (
   ConwayENACT,
+  EnactSignal (..),
   EnactState (..),
   EnactPredFailure (..),
 ) where
@@ -22,6 +23,16 @@ import Cardano.Ledger.Conway.Era (ConwayENACT)
 import Cardano.Ledger.Conway.Governance (
   EnactState (..),
   GovAction (..),
+  GovActionId (..),
+  PrevGovActionId (..),
+  ensCommitteeL,
+  ensConstitutionL,
+  ensCurPParamsL,
+  ensPrevCommitteeL,
+  ensPrevConstitutionL,
+  ensPrevHardForkL,
+  ensPrevPParamUpdateL,
+  ensProtVerL,
  )
 import Cardano.Ledger.Rules.ValidationMode (Inject (..), runTest)
 import Cardano.Ledger.Val (Val (..))
@@ -34,16 +45,22 @@ import Control.State.Transition.Extended (
 import Data.Foldable (fold)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import Lens.Micro
 import Validation (failureUnless)
 
 data EnactPredFailure era
   = EnactTreasuryInsufficientFunds !(Map (RewardAcnt (EraCrypto era)) Coin) !Coin
   deriving (Show, Eq)
 
+data EnactSignal era = EnactSignal
+  { esGovActionId :: !(GovActionId (EraCrypto era))
+  , esGovAction :: !(GovAction era)
+  }
+
 instance EraGov era => STS (ConwayENACT era) where
   type Environment (ConwayENACT era) = ()
   type PredicateFailure (ConwayENACT era) = EnactPredFailure era
-  type Signal (ConwayENACT era) = GovAction era
+  type Signal (ConwayENACT era) = EnactSignal era
   type State (ConwayENACT era) = EnactState era
   type BaseM (ConwayENACT era) = ShelleyBase
 
@@ -52,13 +69,19 @@ instance EraGov era => STS (ConwayENACT era) where
 
 enactmentTransition :: forall era. EraPParams era => TransitionRule (ConwayENACT era)
 enactmentTransition = do
-  TRC ((), st, act) <- judgmentContext
+  TRC ((), st, EnactSignal govActionId act) <- judgmentContext
 
   case act of
-    ParameterChange _prevGovActionId ppup -> pure $ st {ensPParams = newPP}
-      where
-        newPP = ensPParams st `applyPPUpdates` ppup
-    HardForkInitiation _prevGovActionId pv -> pure $ st {ensProtVer = pv}
+    ParameterChange _ ppup ->
+      pure $
+        st
+          & ensCurPParamsL %~ (`applyPPUpdates` ppup)
+          & ensPrevPParamUpdateL .~ SJust (PrevGovActionId govActionId)
+    HardForkInitiation _ pv ->
+      pure $
+        st
+          & ensProtVerL .~ pv
+          & ensPrevHardForkL .~ SJust (PrevGovActionId govActionId)
     TreasuryWithdrawals wdrls -> do
       let wdrlsAmount = fold wdrls
           wdrlsNoNetworkId = Map.mapKeys getRwdCred wdrls
@@ -70,9 +93,21 @@ enactmentTransition = do
           { ensWithdrawals = Map.unionWith (<>) wdrlsNoNetworkId $ ensWithdrawals st
           , ensTreasury = ensTreasury st <-> wdrlsAmount
           }
-    NoConfidence _prevGovActionId -> pure $ st {ensCommittee = SNothing}
-    NewCommittee _prevGovActionId _ committee -> pure $ st {ensCommittee = SJust committee} -- TODO: check old members
-    NewConstitution _prevGovActionId c -> pure $ st {ensConstitution = c}
+    NoConfidence _ ->
+      pure $
+        st
+          & ensCommitteeL .~ SNothing
+          & ensPrevCommitteeL .~ SJust (PrevGovActionId govActionId)
+    NewCommittee _ _ committee ->
+      pure $
+        st
+          & ensCommitteeL .~ SJust committee -- TODO: check old members
+          & ensPrevCommitteeL .~ SJust (PrevGovActionId govActionId)
+    NewConstitution _ c ->
+      pure $
+        st
+          & ensConstitutionL .~ c
+          & ensPrevConstitutionL .~ SJust (PrevGovActionId govActionId)
     InfoAction -> pure st
 
 instance Inject (EnactPredFailure era) (EnactPredFailure era) where

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

@@ -6,6 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -29,10 +30,11 @@ import Cardano.Ledger.Conway.Governance (
   EraGov,
   GovAction (..),
   GovActionState (..),
+  PrevGovActionIds (..),
   RatifyState (..),
   Vote (..),
  )
-import Cardano.Ledger.Conway.Rules.Enact (EnactPredFailure, EnactState (..))
+import Cardano.Ledger.Conway.Rules.Enact (EnactPredFailure, EnactSignal (..), EnactState (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Keys (KeyRole (..))
@@ -71,7 +73,7 @@ instance
   , Embed (EraRule "ENACT" era) (ConwayRATIFY era)
   , State (EraRule "ENACT" era) ~ EnactState era
   , Environment (EraRule "ENACT" era) ~ ()
-  , Signal (EraRule "ENACT" era) ~ GovAction era
+  , Signal (EraRule "ENACT" era) ~ EnactSignal era
   ) =>
   STS (ConwayRATIFY era)
   where
@@ -189,7 +191,7 @@ ratifyTransition ::
   ( Embed (EraRule "ENACT" era) (ConwayRATIFY era)
   , State (EraRule "ENACT" era) ~ EnactState era
   , Environment (EraRule "ENACT" era) ~ ()
-  , Signal (EraRule "ENACT" era) ~ GovAction era
+  , Signal (EraRule "ENACT" era) ~ EnactSignal era
   , Era era
   ) =>
   TransitionRule (ConwayRATIFY era)
@@ -203,11 +205,15 @@ ratifyTransition = do
 
   case rsig of
     ast :<| sigs -> do
-      let GovActionState {gasAction, gasExpiresAfter} = ast
-      if spoAccepted env ast && dRepAccepted env ast dRepThreshold
+      let GovActionState {gasId, gasAction, gasExpiresAfter} = ast
+      if prevActionAsExpected gasAction (ensPrevGovActionIds rsEnactState)
+        && spoAccepted env ast
+        && dRepAccepted env ast dRepThreshold
         then do
           -- Update ENACT state with the governance action that was ratified
-          es <- trans @(EraRule "ENACT" era) $ TRC ((), rsEnactState, gasAction)
+          es <-
+            trans @(EraRule "ENACT" era) $
+              TRC ((), rsEnactState, EnactSignal gasId gasAction)
           let st' =
                 st
                   { rsEnactState = es
@@ -223,6 +229,21 @@ ratifyTransition = do
             else pure st'
     Empty -> pure st
 
+-- | Check that the previous governance action id specified in the proposal
+--   does match the last one of the same purpose that was enacted.
+prevActionAsExpected :: forall era. GovAction era -> PrevGovActionIds era -> Bool
+prevActionAsExpected (ParameterChange prev _) (PrevGovActionIds {pgaPParamUpdate}) =
+  prev == pgaPParamUpdate
+prevActionAsExpected (HardForkInitiation prev _) (PrevGovActionIds {pgaHardFork}) =
+  prev == pgaHardFork
+prevActionAsExpected (NoConfidence prev) (PrevGovActionIds {pgaCommittee}) =
+  prev == pgaCommittee
+prevActionAsExpected (NewCommittee prev _ _) (PrevGovActionIds {pgaCommittee}) =
+  prev == pgaCommittee
+prevActionAsExpected (NewConstitution prev _) (PrevGovActionIds {pgaConstitution}) =
+  prev == pgaConstitution
+prevActionAsExpected _ _ = True -- for the other actions, the last action is not relevant
+
 instance EraGov era => Embed (ConwayENACT era) (ConwayRATIFY era) where
   wrapFailed = id
   wrapEvent = absurd

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

@@ -121,6 +121,14 @@ instance
 instance Crypto (EraCrypto era) => Arbitrary (Constitution era) where
   arbitrary = Constitution <$> arbitrary <*> arbitrary
 
+instance Era era => Arbitrary (PrevGovActionIds era) where
+  arbitrary =
+    PrevGovActionIds
+      <$> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+
 instance
   (Era era, Arbitrary (PParams era), Arbitrary (PParamsUpdate era)) =>
   Arbitrary (EnactState era)
@@ -134,6 +142,7 @@ instance
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> arbitrary
 
 instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (GovActionsState era) where
   arbitrary =