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/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

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

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 =

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) ->

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

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
 -------------------------------------------------------------------------------}