From e720b574241482bd8cc5c3e42324096abee7a2b0 Mon Sep 17 00:00:00 2001 From: Thomas Winant Date: Thu, 29 Oct 2020 10:25:55 +0100 Subject: [PATCH] Use the real Allegra and Mary era tags Fixes #2668. Previously, the Allegra and Mary eras were exactly the same as the Shelley era, so no translations between the eras were needed. In this commit, we use the actual, different `AllegraEra` and `ShelleyEra` tags. This means we need translations between the eras. --- .../ouroboros-consensus-cardano.cabal | 2 ++ .../Consensus/Cardano/CanHardFork.hs | 29 ++++++++++++------- .../src/Ouroboros/Consensus/Cardano/Node.hs | 5 ++-- .../tools/db-analyser/Block/Shelley.hs | 20 ++++++++----- .../ouroboros-consensus-shelley.cabal | 1 + .../src/Ouroboros/Consensus/Shelley/Eras.hs | 21 ++------------ 6 files changed, 39 insertions(+), 39 deletions(-) diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index aa613bc521e..29d80f6dddf 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal @@ -77,6 +77,8 @@ executable db-analyser , cardano-binary , cardano-crypto-wrapper , cardano-ledger + , cardano-ledger-shelley-ma + , cardano-prelude , containers , contra-tracer , directory diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs index a8ea751c064..d13e72c7e0d 100644 --- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs +++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs @@ -25,11 +25,11 @@ module Ouroboros.Consensus.Cardano.CanHardFork ( ) where import Control.Monad -import Control.Monad.Except (Except, throwError) +import Control.Monad.Except (Except, runExcept, throwError) import qualified Data.Map.Strict as Map import Data.Maybe (listToMaybe, mapMaybe) import Data.Proxy -import Data.SOP.Strict ((:.:) (..), NP (..)) +import Data.SOP.Strict ((:.:) (..), NP (..), unComp) import Data.Void (Void) import Data.Word import GHC.Generics (Generic) @@ -48,6 +48,7 @@ import Ouroboros.Consensus.HardFork.History (Bound (boundSlot), addSlots) import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.TypeFamilyWrappers +import Ouroboros.Consensus.Util (eitherToMaybe) import Ouroboros.Consensus.Util.RedundantConstraints import Ouroboros.Consensus.HardFork.Combinator @@ -667,37 +668,45 @@ translateLedgerViewAcrossShelley = -------------------------------------------------------------------------------} translateLedgerStateShelleyToAllegraWrapper :: - RequiringBoth + PraosCrypto c + => RequiringBoth WrapLedgerConfig (Translate LedgerState) (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (AllegraEra c)) translateLedgerStateShelleyToAllegraWrapper = ignoringBoth $ - Translate $ \_epochNo ledgerShelley -> ledgerShelley + Translate $ \_epochNo -> + unComp . SL.translateEra' () . Comp translateTxShelleyToAllegraWrapper :: - InjectTx + PraosCrypto c + => InjectTx (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (AllegraEra c)) -translateTxShelleyToAllegraWrapper = InjectTx Just +translateTxShelleyToAllegraWrapper = InjectTx $ + fmap unComp . eitherToMaybe . runExcept . SL.translateEra () . Comp {------------------------------------------------------------------------------- Translation from Shelley to Allegra -------------------------------------------------------------------------------} translateLedgerStateAllegraToMaryWrapper :: - RequiringBoth + PraosCrypto c + => RequiringBoth WrapLedgerConfig (Translate LedgerState) (ShelleyBlock (AllegraEra c)) (ShelleyBlock (MaryEra c)) translateLedgerStateAllegraToMaryWrapper = ignoringBoth $ - Translate $ \_epochNo ledgerAllegra -> ledgerAllegra + Translate $ \_epochNo -> + unComp . SL.translateEra' () . Comp translateTxAllegraToMaryWrapper :: - InjectTx + PraosCrypto c + => InjectTx (ShelleyBlock (AllegraEra c)) (ShelleyBlock (MaryEra c)) -translateTxAllegraToMaryWrapper = InjectTx Just +translateTxAllegraToMaryWrapper = InjectTx $ + fmap unComp . eitherToMaybe . runExcept . SL.translateEra () . Comp diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs index 2b7494f4dba..610882ee563 100644 --- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs +++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs @@ -71,6 +71,7 @@ import qualified Ouroboros.Consensus.Byron.Ledger.Conversions as Byron import Ouroboros.Consensus.Byron.Ledger.NetworkProtocolVersion import Ouroboros.Consensus.Byron.Node +import qualified Cardano.Ledger.Era as SL import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley import Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion @@ -478,7 +479,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { -- Allegra genesisAllegra :: ShelleyGenesis (AllegraEra c) - genesisAllegra = genesisShelley + genesisAllegra = SL.translateEra' () genesisShelley blockConfigAllegra :: BlockConfig (ShelleyBlock (AllegraEra c)) blockConfigAllegra = @@ -501,7 +502,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron { -- Mary genesisMary :: ShelleyGenesis (MaryEra c) - genesisMary = genesisAllegra + genesisMary = SL.translateEra' () genesisAllegra blockConfigMary :: BlockConfig (ShelleyBlock (MaryEra c)) blockConfigMary = diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs b/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs index 02d4951e288..42bba53f093 100644 --- a/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs +++ b/ouroboros-consensus-cardano/tools/db-analyser/Block/Shelley.hs @@ -1,7 +1,11 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -14,6 +18,8 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BL import Data.Foldable (asum, toList) import qualified Data.Map.Strict as Map +import Data.Sequence.Strict (StrictSeq) +import GHC.Records (HasField, getField) import Options.Applicative import qualified Cardano.Ledger.Core as Core @@ -34,15 +40,13 @@ import HasAnalysis -- | Usable for each Shelley-based era instance ( ShelleyBasedEra era - -- TODO this will have to be generalised for the real Mary era (and - -- Allegra?), which will have a different 'Core.TxBody'. - , Core.TxBody era ~ SL.TxBody era + , HasField "outputs" (Core.TxBody era) (StrictSeq (SL.TxOut era)) ) => HasAnalysis (ShelleyBlock era) where countTxOutputs blk = case Shelley.shelleyBlockRaw blk of SL.Block _ (SL.TxSeq txs) -> sum $ fmap countOutputs txs where countOutputs :: SL.Tx era -> Int - countOutputs = length . SL._outputs . SL._body + countOutputs = length . getField @"outputs" . SL._body blockTxSizes blk = case Shelley.shelleyBlockRaw blk of SL.Block _ (SL.TxSeq txs) -> diff --git a/ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal b/ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal index 756438144ec..56b9f2df3e3 100644 --- a/ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal +++ b/ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal @@ -63,6 +63,7 @@ library -- cardano-ledger-specs , shelley-spec-ledger , shelley-spec-non-integral + , cardano-ledger-shelley-ma , small-steps , ouroboros-network diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs index 43c28323b8a..b87d80d5e80 100644 --- a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs +++ b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs @@ -15,31 +15,14 @@ module Ouroboros.Consensus.Shelley.Eras ( , StandardCrypto ) where +import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Era (Crypto) +import Cardano.Ledger.Mary (MaryEra) import Cardano.Ledger.Shelley (ShelleyEra) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) import Shelley.Spec.Ledger.API (ShelleyBasedEra) -{------------------------------------------------------------------------------- - Eras based on the Shelley ledger --------------------------------------------------------------------------------} - --- | The era after Shelley is Allegra, the illegitimate daughter of Byron. --- --- In this era, we introduce time locks and miscellaneous fixes for the Shelley --- era. --- --- TODO #2668 Change this to the proper Allegra era -type AllegraEra c = ShelleyEra c - --- | The era after Allegra is Mary (Shelley), the wife of Percy Shelley. --- --- In this era, we introduce multi-asset (hence MA-ry). --- --- TODO #2668 Change this to the proper Mary era -type MaryEra c = ShelleyEra c - {------------------------------------------------------------------------------- Eras instantiated with standard crypto -------------------------------------------------------------------------------}