Integrate cardano-ledger for node-8.11.0

cabal.project

@@ -16,7 +16,7 @@ index-state:
   -- Bump this if you need newer packages from Hackage
   , hackage.haskell.org 2024-03-26T06:28:59Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-05-07T20:35:20Z
+  , cardano-haskell-packages 2024-05-13T13:19:15Z
 
 packages:
   ouroboros-consensus

ouroboros-consensus-cardano/changelog.d/20240430_233346_Lucsanszky_integration_8_11.md

@@ -0,0 +1,14 @@
+### Patch
+
+- Update `SupportsTwoPhaseValidation` instance for `Conway`:
+  `ConwayUtxowFailure` was changed upstream
+
+### Non-Breaking
+
+- Update ledger packages:
+  - `cardano-ledger-alonzo`: `^>=1.8`
+  - `cardano-ledger-babbage`: `^>=1.8`
+  - `cardano-ledger-conway`: `^>=1.14`
+  - `cardano-ledger-core`: `^>=1.12`
+  - `cardano-ledger-mary`: `^>=1.6`
+  - `cardano-ledger-shelley`: `^>=1.11`

ouroboros-consensus-cardano/changelog.d/20240507_211718_alexey.kuleshevich_hardfork_initiation.md

@@ -0,0 +1,25 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- Remove `getProposedProtocolVersion` and `defaultGetProposedProtocolVersion`
+- Remove `ProtocolUpdate`, `UpdateProposal`, `UpdateState` and `protocolUpdates`
+- Add `pparamsUpdate`
+- Change `ShelleyLedgerUpdate` by replacing `ShelleyUpdatedProtocolUpdates` with `ShelleyUpdatedPParams`

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -134,15 +134,15 @@ library
     cardano-crypto-class,
     cardano-crypto-wrapper,
     cardano-ledger-allegra ^>=1.4,
-    cardano-ledger-alonzo ^>=1.7,
+    cardano-ledger-alonzo ^>=1.8,
     cardano-ledger-api ^>=1.9,
-    cardano-ledger-babbage ^>=1.7,
+    cardano-ledger-babbage ^>=1.8,
     cardano-ledger-binary ^>=1.3,
     cardano-ledger-byron ^>=1.0,
-    cardano-ledger-conway ^>=1.13,
-    cardano-ledger-core ^>=1.11,
-    cardano-ledger-mary ^>=1.5,
-    cardano-ledger-shelley ^>=1.10,
+    cardano-ledger-conway ^>=1.14,
+    cardano-ledger-core ^>=1.12,
+    cardano-ledger-mary ^>=1.6,
+    cardano-ledger-shelley ^>=1.11,
     cardano-prelude,
     cardano-protocol-tpraos ^>=1.2,
     cardano-slotting,

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs

@@ -72,7 +72,6 @@ import           Control.Monad.Except
 import           Control.State.Transition (PredicateFailure)
 import           Data.Data (Proxy (Proxy))
 import           Data.List.NonEmpty (NonEmpty ((:|)))
-import           Lens.Micro ((^.))
 import           NoThunks.Class (NoThunks)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
                      (WhetherToIntervene (..))
@@ -159,14 +158,6 @@ class ( Core.EraSegWits era
          , SL.Validated (Core.Tx era)
          )
 
-  -- | Get the protocol version out of a 'Core.PParamsUpdate', used to detect
-  -- whether we should perform a HF. This will likely be removed/changed once we
-  -- implement HF enactment in Conway (see
-  -- <https://github.com/IntersectMBO/ouroboros-consensus/issues/61>).
-  --
-  -- For now, this always returns 'Nothing' for Conway (see the instance below).
-  getProposedProtocolVersion :: Core.PParamsUpdate era -> Maybe ProtVer
-
   -- | Whether the era has an instance of 'CG.ConwayEraGov'
   getConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
 
@@ -194,58 +185,41 @@ defaultApplyShelleyBasedTx globals ledgerEnv mempoolState _wti tx =
       mempoolState
       tx
 
-defaultGetProposedProtocolVersion ::
-     (EraPParams era, ProtVerAtMost era 8)
-  => Core.PParamsUpdate era
-  -> Maybe ProtVer
-defaultGetProposedProtocolVersion proposal =
-    strictMaybeToMaybe $ proposal ^. ppuProtocolVersionL
-
 defaultGetConwayEraGovDict :: proxy era -> Maybe (ConwayEraGovDict era)
 defaultGetConwayEraGovDict _ = Nothing
 
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (ShelleyEra c) where
   applyShelleyBasedTx = defaultApplyShelleyBasedTx
 
-  getProposedProtocolVersion = defaultGetProposedProtocolVersion
-
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (AllegraEra c) where
   applyShelleyBasedTx = defaultApplyShelleyBasedTx
 
-  getProposedProtocolVersion = defaultGetProposedProtocolVersion
-
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (MaryEra c) where
   applyShelleyBasedTx = defaultApplyShelleyBasedTx
 
-  getProposedProtocolVersion = defaultGetProposedProtocolVersion
-
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
 instance (SL.PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
   => ShelleyBasedEra (AlonzoEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
 
-  getProposedProtocolVersion = defaultGetProposedProtocolVersion
-
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
 instance (Praos.PraosCrypto c) => ShelleyBasedEra (BabbageEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
 
-  getProposedProtocolVersion = defaultGetProposedProtocolVersion
-
   getConwayEraGovDict = defaultGetConwayEraGovDict
 
 instance (Praos.PraosCrypto c) => ShelleyBasedEra (ConwayEra c) where
   applyShelleyBasedTx = applyAlonzoBasedTx
-  getProposedProtocolVersion _ = Nothing
+
   getConwayEraGovDict _ = Just ConwayEraGovDict
 
 applyAlonzoBasedTx :: forall era.
@@ -353,30 +327,13 @@ instance SupportsTwoPhaseValidation (BabbageEra c) where
 instance SupportsTwoPhaseValidation (ConwayEra c) where
   isIncorrectClaimedFlag _ = \case
     SL.ConwayUtxowFailure
-      ( Babbage.AlonzoInBabbageUtxowPredFailure
-          ( Alonzo.ShelleyInAlonzoUtxowPredFailure
-              ( SL.UtxoFailure
-                  ( Babbage.AlonzoInBabbageUtxoPredFailure
-                      ( Alonzo.UtxosFailure
-                          ( Conway.ValidationTagMismatch
-                              (Alonzo.IsValid _claimedFlag)
-                              _validationErrs
-                            )
-                        )
-                    )
-                )
-            )
-        ) -> True
-    SL.ConwayUtxowFailure
-      ( Babbage.UtxoFailure
-          ( Babbage.AlonzoInBabbageUtxoPredFailure
-              ( Alonzo.UtxosFailure
+      ( Conway.UtxoFailure
+              ( Conway.UtxosFailure
                   ( Conway.ValidationTagMismatch
                       (Alonzo.IsValid _claimedFlag)
                       _validationErrs
                   )
               )
-          )
       ) -> True
     _ -> False
 

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Inspect.hs

@@ -8,166 +8,55 @@
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Ouroboros.Consensus.Shelley.Ledger.Inspect (
-    ProtocolUpdate (..)
-  , ShelleyLedgerUpdate (..)
-  , UpdateProposal (..)
-  , UpdateState (..)
-  , protocolUpdates
+    ShelleyLedgerUpdate (..)
+  , pparamsUpdate
   ) where
 
+import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.Core as Core
+import qualified Cardano.Ledger.Shelley.Governance as SL
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
-import qualified Cardano.Ledger.Shelley.PParams as SL
 import           Control.Monad
-import           Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import           Data.Maybe (fromMaybe)
 import           Data.Void
-import           Data.Word (Word64)
-import           Lens.Micro.Extras (view)
+import           Lens.Micro ((^.))
 import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Inspect
-import           Ouroboros.Consensus.Shelley.Eras (EraCrypto,
-                     ShelleyBasedEra (..))
 import           Ouroboros.Consensus.Shelley.Ledger.Block
 import           Ouroboros.Consensus.Shelley.Ledger.Ledger
 import           Ouroboros.Consensus.Util.Condense
 
-data ProtocolUpdate era = ProtocolUpdate {
-      protocolUpdateProposal :: UpdateProposal era
-    , protocolUpdateState    :: UpdateState (EraCrypto era)
-    }
-deriving instance Eq (Core.PParamsUpdate era) => Eq (ProtocolUpdate era)
-deriving instance Show (Core.PParamsUpdate era) => Show (ProtocolUpdate era)
-
--- | Update proposal
---
--- As in Byron, a proposal is a partial map from parameters to their values.
-data UpdateProposal era = UpdateProposal {
-      -- | The protocol parameters changed by this update proposal
-      --
-      -- An update is /identified/ by how it updates the protocol parameters.
-      proposalParams  :: Core.PParamsUpdate era
-
-      -- | New version (if changed by this proposal)
-      --
-      -- The protocol version itself is also considered to be just another
-      -- parameter, and parameters can change /without/ changing the protocol
-      -- version, although a convention /could/ be established that the protocol
-      -- version must change if any of the parameters do; but the specification
-      -- itself does not mandate this.
-      --
-      -- We record the version separately for the convenience of the HFC.
-    , proposalVersion :: Maybe SL.ProtVer
-
-      -- | The 'EpochNo' the proposal becomes active in, if it is adopted
-    , proposalEpoch   :: EpochNo
-    }
-
-deriving instance Eq (Core.PParamsUpdate era) => Eq (UpdateProposal era)
-deriving instance Show (Core.PParamsUpdate era) => Show (UpdateProposal era)
-
--- | Proposal state
---
--- The update mechanism in Shelley is simpler than it is in Byron. There is no
--- distinction between votes and proposals: to \"vote\" for a proposal one
--- merely submits the exact same proposal. There is also no separate
--- endorsement step. The procedure is as follows:
---
--- 1. During each epoch, a genesis key can submit (via its delegates) zero,
---    one, or many proposals; each submission overrides the previous one.
--- 2. \"Voting\" (submitting of proposals) ends @2 * stabilityWindow@ slots
---    (i.e. @6k/f@) before the end of the epoch. In other words, proposals
---    for the upcoming epoch must be submitted within the first @4k/f@ slots
---    of this one.
--- 3. At the end of an epoch, if the majority of nodes (as determined by the
---    @Quorum@ specification constant, which must be greater than half the
---    nodes) have most recently submitted the same exact proposal, then it is
---    adopted.
--- 4. The next epoch is always started with a clean slate, proposals from the
---    previous epoch that didn't make it are discarded (except for "future
---    proposals" that are explicitly marked for future epochs).
-data UpdateState c = UpdateState {
-      -- | The genesis delegates that voted for this proposal
-      proposalVotes         :: [SL.KeyHash 'SL.Genesis c]
-
-      -- | Has this proposal reached sufficient votes to be adopted?
-    , proposalReachedQuorum :: Bool
-    }
-  deriving (Show, Eq)
-
-protocolUpdates ::
-       forall era proto. ShelleyBasedEra era
-    => SL.ShelleyGenesis (EraCrypto era)
-    -> LedgerState (ShelleyBlock proto era)
-    -> [ProtocolUpdate era]
-protocolUpdates genesis st = [
-      ProtocolUpdate {
-          protocolUpdateProposal = UpdateProposal {
-              proposalParams  = proposal
-            , proposalEpoch   = succ currentEpoch
-            , proposalVersion = getProposedProtocolVersion proposal
-            }
-        , protocolUpdateState = UpdateState {
-              proposalVotes         = votes
-            , proposalReachedQuorum = length votes >= fromIntegral quorum
-            }
-        }
-    | (proposal, votes) <- Map.toList $ invertMap proposals
-    ]
-  where
-    invertMap :: Ord b => Map a b -> Map b [a]
-    invertMap = Map.fromListWith (<>) . fmap swizzle . Map.toList
-      where
-        swizzle (a, b) = (b, [a])
-
-    -- Updated proposed within the proposal window
-    proposals :: Map (SL.KeyHash 'SL.Genesis (EraCrypto era)) (Core.PParamsUpdate era)
-    SL.ProposedPPUpdates proposals =
-          fromMaybe SL.emptyPPPUpdates
-        . Core.getProposedPPUpdates
-        . view SL.newEpochStateGovStateL
-        . shelleyLedgerState
-        $ st
-
-    -- A proposal is accepted if the number of votes is equal to or greater
-    -- than the quorum. The quorum itself must be strictly greater than half
-    -- the number of genesis keys, but we do not rely on that property here.
-    quorum :: Word64
-    quorum = SL.sgUpdateQuorum genesis
-
-    -- The proposals in 'SL.proposals' are for the upcoming epoch
-    -- (we ignore 'futureProposals')
-    currentEpoch :: EpochNo
-    currentEpoch = SL.nesEL . shelleyLedgerState $ st
-
-{-------------------------------------------------------------------------------
-  Inspection
--------------------------------------------------------------------------------}
-
 data ShelleyLedgerUpdate era =
-    ShelleyUpdatedProtocolUpdates [ProtocolUpdate era]
+  ShelleyUpdatedPParams
+    !(StrictMaybe (Core.PParams era))
+    !EpochNo
 
-deriving instance Eq (Core.PParamsUpdate era) => Eq (ShelleyLedgerUpdate era)
-deriving instance Show (Core.PParamsUpdate era) => Show (ShelleyLedgerUpdate era)
+deriving instance Eq (Core.PParams era) => Eq (ShelleyLedgerUpdate era)
+deriving instance Show (Core.PParams era) => Show (ShelleyLedgerUpdate era)
 
-instance Show (Core.PParamsUpdate era) => Condense (ShelleyLedgerUpdate era) where
+instance Show (Core.PParams era) => Condense (ShelleyLedgerUpdate era) where
   condense = show
 
 instance ShelleyBasedEra era => InspectLedger (ShelleyBlock proto era) where
   type LedgerWarning (ShelleyBlock proto era) = Void
   type LedgerUpdate  (ShelleyBlock proto era) = ShelleyLedgerUpdate era
 
-  inspectLedger tlc before after = do
+  inspectLedger _tlc before after = do
       guard $ updatesBefore /= updatesAfter
-      return $ LedgerUpdate $ ShelleyUpdatedProtocolUpdates updatesAfter
+      return $ LedgerUpdate updatesAfter
     where
-      genesis :: SL.ShelleyGenesis (EraCrypto era)
-      genesis = shelleyLedgerGenesis (configLedger tlc)
 
-      updatesBefore, updatesAfter :: [ProtocolUpdate era]
-      updatesBefore = protocolUpdates genesis before
-      updatesAfter  = protocolUpdates genesis after
+      updatesBefore, updatesAfter :: ShelleyLedgerUpdate era
+      updatesBefore = pparamsUpdate before
+      updatesAfter  = pparamsUpdate after
+
+pparamsUpdate ::
+       forall era proto. ShelleyBasedEra era
+    => LedgerState (ShelleyBlock proto era)
+    -> ShelleyLedgerUpdate era
+pparamsUpdate st =
+    let nes = shelleyLedgerState st
+     in ShelleyUpdatedPParams
+          (SL.nextEpochUpdatedPParams (nes ^. SL.newEpochStateGovStateL))
+          (succ (SL.nesEL nes))