Merge branch 'master' into jj/remove-protver

eras/conway/impl/CHANGELOG.md

@@ -11,6 +11,25 @@
 * Remove `ConwayEpochPredFailure`
 * Remove `EpochFailure` and `RatifyFailure` from `ConwayNewEpochPredFailure`
 * Change `PredicateFailure (ConwayRATIFY era)` to `Void`
+* Move `ConwayEraTxBody` to `Cardano.Ledger.Conway.TxBody`
+* Move `ConwayEraPParams` to `Cardano.Ledger.Conway.PParams`
+* Rename:
+  * `GovActionsState` to `GovSnapshots`
+  * `cgGovActionsStateL` to `cgGovSnapshotsL`
+  * `curGovActionsStateL` to `curGovSnapshotsL`
+  * `prevGovActionsStateL` to `prevGovSnapshotsL`
+* Add:
+  * `ProposalsSnapshot`
+  * `snapshotIds`
+  * `snapshotAddVote`
+  * `snapshotInsertGovAction`
+  * `snapshotActions`
+  * `snapshotRemoveIds`
+  * `fromGovActionStateSeq`
+Add lenses:
+  * `gasCommitteeVotesL`
+  * `gasDRepVotesL`
+  * `gasStakePoolVotesL`
 * Add:
   * `rsDelayed`
   * `PParamGroup`

eras/conway/impl/cardano-ledger-conway.cabal

@@ -41,6 +41,7 @@ library
     other-modules:
         Cardano.Ledger.Conway.Era
         Cardano.Ledger.Conway.Governance.Procedures
+        Cardano.Ledger.Conway.Governance.Snapshots
         Cardano.Ledger.Conway.Rules.Cert
         Cardano.Ledger.Conway.Rules.Deleg
         Cardano.Ledger.Conway.Rules.Pool
@@ -107,6 +108,7 @@ library testlib
         cardano-ledger-babbage:testlib,
         cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
         cardano-ledger-conway,
+        cardano-strict-containers,
         small-steps
 
 test-suite tests

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

@@ -1,43 +1,18 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
 module Cardano.Ledger.Conway.Core (
   module X,
-  ConwayEraTxBody (..),
-  ConwayEraPParams (..),
-  PParamGroup (..),
-  ParamGrouper,
-  pGroup,
-  pUngrouped,
-  modifiedGroups,
-  ppPoolVotingThresholdsL,
-  ppDRepVotingThresholdsL,
-  ppMinCommitteeSizeL,
-  ppCommitteeTermLimitL,
-  ppGovActionExpirationL,
-  ppGovActionDepositL,
-  ppDRepDepositL,
-  ppDRepActivityL,
-  ppuPoolVotingThresholdsL,
-  ppuDRepVotingThresholdsL,
-  ppuMinCommitteeSizeL,
-  ppuCommitteeTermLimitL,
-  ppuGovActionExpirationL,
-  ppuGovActionDepositL,
-  ppuDRepDepositL,
-  ppuDRepActivityL,
   PoolVotingThresholds (..),
   DRepVotingThresholds (..),
   dvtPPNetworkGroupL,
@@ -48,126 +23,18 @@ module Cardano.Ledger.Conway.Core (
 )
 where
 
-import Cardano.Ledger.Ap (Ap, runAp_)
 import Cardano.Ledger.Babbage.Core as X
-import Cardano.Ledger.BaseTypes (EpochNo, StrictMaybe (..), UnitInterval)
+import Cardano.Ledger.BaseTypes (UnitInterval)
 import Cardano.Ledger.Binary (DecCBOR, EncCBOR, decodeRecordNamed, encodeListLen)
 import Cardano.Ledger.Binary.Decoding (DecCBOR (decCBOR))
 import Cardano.Ledger.Binary.Encoding (EncCBOR (encCBOR))
-import Cardano.Ledger.Coin (Coin)
-import Cardano.Ledger.Conway.Governance.Procedures (ProposalProcedure, VotingProcedures)
-import Cardano.Ledger.HKD (HKD, HKDFunctor)
 import Cardano.Ledger.TreeDiff (ToExpr)
 import Control.DeepSeq (NFData)
 import Data.Aeson (ToJSON)
 import Data.Default.Class (Default)
-import Data.Functor.Identity (Identity)
-import Data.Sequence.Strict (StrictSeq (..))
-import Data.Set (Set)
-import qualified Data.Set as Set
 import GHC.Generics (Generic)
 import Lens.Micro (Lens', lens)
 import NoThunks.Class (NoThunks)
-import Numeric.Natural (Natural)
-
-class BabbageEraTxBody era => ConwayEraTxBody era where
-  -- | Lens for getting and setting number of `Coin` that is expected to be in the
-  -- Treasury at the current Epoch
-  currentTreasuryValueTxBodyL :: Lens' (TxBody era) (StrictMaybe Coin)
-
-  -- | Lens for getting and setting `VotingProcedures`.
-  votingProceduresTxBodyL :: Lens' (TxBody era) (VotingProcedures era)
-
-  -- | Lens for getting and setting `ProposalProcedures`.
-  proposalProceduresTxBodyL :: Lens' (TxBody era) (StrictSeq (ProposalProcedure era))
-
-  treasuryDonationTxBodyL :: Lens' (TxBody era) Coin
-
-data PParamGroup
-  = EconomicGroup
-  | NetworkGroup
-  | TechnicalGroup
-  | GovernanceGroup
-  deriving (Eq, Ord)
-
-newtype ParamGrouper a = ParamGrouper {unParamGrouper :: Set PParamGroup}
-  deriving (Functor)
-
-pGroup :: PParamGroup -> StrictMaybe a -> Ap f (ParamGrouper a)
-pGroup pg (SJust _) = pure . ParamGrouper $ Set.singleton pg
-pGroup _ SNothing = pure $ ParamGrouper mempty
-
-pUngrouped :: Ap f (ParamGrouper a)
-pUngrouped = pure $ ParamGrouper mempty
-
-modifiedGroups ::
-  forall era.
-  ConwayEraPParams era =>
-  PParamsUpdate era ->
-  Set PParamGroup
-modifiedGroups = runAp_ unParamGrouper . (pparamsGroups @era)
-
-class BabbageEraPParams era => ConwayEraPParams era where
-  pparamsGroups ::
-    Functor f => PParamsUpdate era -> Ap f (PParamsHKD ParamGrouper era)
-  ppuWellFormed :: PParamsUpdate era -> Bool
-
-  hkdPoolVotingThresholdsL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f PoolVotingThresholds)
-  hkdDRepVotingThresholdsL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f DRepVotingThresholds)
-  hkdMinCommitteeSizeL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Natural)
-  hkdCommitteeTermLimitL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Natural)
-  hkdGovActionExpirationL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochNo)
-  hkdGovActionDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
-  hkdDRepDepositL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin)
-  hkdDRepActivityL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f EpochNo)
-
-ppPoolVotingThresholdsL :: forall era. ConwayEraPParams era => Lens' (PParams era) PoolVotingThresholds
-ppPoolVotingThresholdsL = ppLens . hkdPoolVotingThresholdsL @era @Identity
-
-ppDRepVotingThresholdsL :: forall era. ConwayEraPParams era => Lens' (PParams era) DRepVotingThresholds
-ppDRepVotingThresholdsL = ppLens . hkdDRepVotingThresholdsL @era @Identity
-
-ppMinCommitteeSizeL :: forall era. ConwayEraPParams era => Lens' (PParams era) Natural
-ppMinCommitteeSizeL = ppLens . hkdMinCommitteeSizeL @era @Identity
-
-ppCommitteeTermLimitL :: forall era. ConwayEraPParams era => Lens' (PParams era) Natural
-ppCommitteeTermLimitL = ppLens . hkdCommitteeTermLimitL @era @Identity
-
-ppGovActionExpirationL :: forall era. ConwayEraPParams era => Lens' (PParams era) EpochNo
-ppGovActionExpirationL = ppLens . hkdGovActionExpirationL @era @Identity
-
-ppGovActionDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
-ppGovActionDepositL = ppLens . hkdGovActionDepositL @era @Identity
-
-ppDRepDepositL :: forall era. ConwayEraPParams era => Lens' (PParams era) Coin
-ppDRepDepositL = ppLens . hkdDRepDepositL @era @Identity
-
-ppDRepActivityL :: forall era. ConwayEraPParams era => Lens' (PParams era) EpochNo
-ppDRepActivityL = ppLens . hkdDRepActivityL @era @Identity
-
-ppuPoolVotingThresholdsL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
-ppuPoolVotingThresholdsL = ppuLens . hkdPoolVotingThresholdsL @era @StrictMaybe
-
-ppuDRepVotingThresholdsL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
-ppuDRepVotingThresholdsL = ppuLens . hkdDRepVotingThresholdsL @era @StrictMaybe
-
-ppuMinCommitteeSizeL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Natural)
-ppuMinCommitteeSizeL = ppuLens . hkdMinCommitteeSizeL @era @StrictMaybe
-
-ppuCommitteeTermLimitL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Natural)
-ppuCommitteeTermLimitL = ppuLens . hkdCommitteeTermLimitL @era @StrictMaybe
-
-ppuGovActionExpirationL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe EpochNo)
-ppuGovActionExpirationL = ppuLens . hkdGovActionExpirationL @era @StrictMaybe
-
-ppuGovActionDepositL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
-ppuGovActionDepositL = ppuLens . hkdGovActionDepositL @era @StrictMaybe
-
-ppuDRepDepositL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe Coin)
-ppuDRepDepositL = ppuLens . hkdDRepDepositL @era @StrictMaybe
-
-ppuDRepActivityL :: forall era. ConwayEraPParams era => Lens' (PParamsUpdate era) (StrictMaybe EpochNo)
-ppuDRepActivityL = ppuLens . hkdDRepActivityL @era @StrictMaybe
 
 data PoolVotingThresholds = PoolVotingThresholds
   { pvtMotionNoConfidence :: !UnitInterval