Use the real Allegra and Mary era tags

cabal.project

@@ -152,8 +152,8 @@ source-repository-package
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/cardano-ledger-specs
- tag: f1b1a0c3832aa3edffecebd744acd978d5d6611e
- --sha256: 0zm3l434dkf6z0nb78iak4s9ppycqnl4f7nridkv0l0q9ahwzbk8
+ tag: 8d836e61bb88bda4a6a5c00694735928390067a1
+ --sha256: 0jpdz2294k5q8c90hbg7s808ypglar94j1rm2x81h69ilsp5g3j3
  subdir:
  byron/chain/executable-spec
  byron/crypto
@@ -167,6 +167,7 @@ source-repository-package
  shelley/chain-and-ledger/executable-spec
  shelley/chain-and-ledger/shelley-spec-ledger-test
  shelley-ma/impl
+ shelley-ma/shelley-ma-test
 
 source-repository-package
  type: git

ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Generators.hs

@@ -59,7 +59,6 @@ import qualified Test.Cardano.Chain.UTxO.Gen as CC
 import qualified Test.Cardano.Crypto.Gen as CC
 
 import Test.Util.Orphans.Arbitrary ()
-import Test.Util.Orphans.Slotting.Arbitrary ()
 import Test.Util.Serialisation.Roundtrip (SomeResult (..),
  WithVersion (..))
 
@@ -272,7 +271,7 @@ instance Arbitrary (TipInfoIsEBB ByronBlock) where
 
 instance Arbitrary (AnnTip ByronBlock) where
  arbitrary = AnnTip
- <$> arbitrary
+ <$> (SlotNo <$> arbitrary)
  <*> (BlockNo <$> arbitrary)
  <*> arbitrary
 

ouroboros-consensus-cardano-test/test/Test/Consensus/Cardano/Golden.hs

@@ -36,4 +36,5 @@ instance CardanoHardForkConstraints c
  CardanoNodeToClientVersion2 -> "CardanoNodeToClientVersion2"
  CardanoNodeToClientVersion3 -> "CardanoNodeToClientVersion3"
  CardanoNodeToClientVersion4 -> "CardanoNodeToClientVersion4"
+ CardanoNodeToClientVersion5 -> "CardanoNodeToClientVersion5"
  _ -> error $ "Unknown version: " <> show v

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
@@ -300,19 +301,17 @@ instance CardanoHardForkConstraints c
  [ (NodeToNodeV_1, CardanoNodeToNodeVersion1)
  , (NodeToNodeV_2, CardanoNodeToNodeVersion2)
  , (NodeToNodeV_3, CardanoNodeToNodeVersion2)
- -- TODO #2670 enable these
- -- , (NodeToNodeV_4, CardanoNodeToNodeVersion3)
- -- , (NodeToNodeV_5, CardanoNodeToNodeVersion4)
+ , (NodeToNodeV_4, CardanoNodeToNodeVersion3)
+ , (NodeToNodeV_5, CardanoNodeToNodeVersion4)
  ]
 
  supportedNodeToClientVersions _ = Map.fromList $
  [ (NodeToClientV_1, CardanoNodeToClientVersion1)
  , (NodeToClientV_2, CardanoNodeToClientVersion1)
  , (NodeToClientV_3, CardanoNodeToClientVersion2)
  , (NodeToClientV_4, CardanoNodeToClientVersion3)
- -- TODO #2670 enable these
- -- , (NodeToClientV_5, CardanoNodeToClientVersion4)
- -- , (NodeToClientV_6, CardanoNodeToClientVersion5)
+ , (NodeToClientV_5, CardanoNodeToClientVersion4)
+ , (NodeToClientV_6, CardanoNodeToClientVersion5)
  ]
 
 {-------------------------------------------------------------------------------
@@ -478,7 +477,7 @@ protocolInfoCardano protocolParamsByron@ProtocolParamsByron {
  -- Allegra
 
  genesisAllegra :: ShelleyGenesis (AllegraEra c)
- genesisAllegra = genesisShelley
+ genesisAllegra = SL.translateEra' () genesisShelley
 
  blockConfigAllegra :: BlockConfig (ShelleyBlock (AllegraEra c))
  blockConfigAllegra =
@@ -501,7 +500,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-test/ouroboros-consensus-shelley-test.cabal

@@ -45,8 +45,10 @@ library
  , transformers
 
  -- cardano-ledger-specs
+ , cardano-ledger-shelley-ma-test
  , shelley-spec-ledger
  , shelley-spec-ledger-test
+ , small-steps
 
  , ouroboros-network
  , ouroboros-consensus

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Generators.hs

@@ -36,9 +36,12 @@ import Test.Util.Orphans.Arbitrary ()
 import Test.Util.Serialisation.Roundtrip (SomeResult (..),
  WithVersion (..))
 
+import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
 import Test.Consensus.Shelley.MockCrypto (CanMock)
 import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes as SL
-import Test.Shelley.Spec.Ledger.Serialisation.Generators (genPParams)
+import Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators
+ (genPParams)
+import Test.Shelley.Spec.Ledger.Serialisation.Generators ()
 
 {-------------------------------------------------------------------------------
  Generators

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs

@@ -18,14 +18,14 @@ import Cardano.Crypto.DSIGN (MockDSIGN)
 import Cardano.Crypto.Hash (HashAlgorithm)
 import Cardano.Crypto.KES (MockKES)
 
-import  Cardano.Ledger.Core (Value)
+import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Crypto (Crypto (..))
-import Cardano.Ledger.Torsor (Delta)
+import Control.State.Transition.Extended (PredicateFailure)
 import qualified Shelley.Spec.Ledger.API as SL
+import qualified Shelley.Spec.Ledger.Tx as SL (ValidateScript)
 
 import Test.Cardano.Crypto.VRF.Fake (FakeVRF)
 import qualified Test.Shelley.Spec.Ledger.ConcreteCryptoTypes as SL (Mock)
-import qualified Test.Shelley.Spec.Ledger.Utils as SL (ShelleyTest)
 
 import Ouroboros.Consensus.Shelley.Eras (EraCrypto, ShelleyBasedEra,
  ShelleyEra)
@@ -57,9 +57,9 @@ type Block h = ShelleyBlock (MockShelley h)
 type CanMock era =
  ( ShelleyBasedEra era
  , SL.Mock (EraCrypto era)
-  -- TODO #2677 the generators in the ledger impose this constraint
- , SL.ShelleyTest era
- , Arbitrary (SL.WitnessSet era)
- , Arbitrary (Value era)
- , Arbitrary (Delta (Value era))
+ , SL.ValidateScript era
+ , Arbitrary (Core.TxBody era)
+ , Arbitrary (Core.Value era)
+ , Arbitrary (Core.Script era)
+ , Arbitrary (PredicateFailure (SL.UTXOW era))
  )

ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal

@@ -61,6 +61,7 @@ library
  , transformers
 
  -- cardano-ledger-specs
+ , cardano-ledger-shelley-ma
  , shelley-spec-ledger
  , shelley-spec-non-integral
  , small-steps

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

ouroboros-network/src/Ouroboros/Network/NodeToClient/Version.hs

@@ -31,6 +31,10 @@ data NodeToClientVersion
  -- ^ enabled @CardanoNodeToClientVersion2@
  | NodeToClientV_4
  -- ^ enabled @CardanoNodeToClientVersion3@, adding more queries
+ | NodeToClientV_5
+ -- ^ enabled @CardanoNodeToClientVersion4@, i.e., Allegra
+ | NodeToClientV_6
+ -- ^ enabled @CardanoNodeToClientVersion5@, i.e., Mary
  deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and
@@ -47,6 +51,8 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
  encodeTerm NodeToClientV_2 = CBOR.TInt (2 `setBit` nodeToClientVersionBit)
  encodeTerm NodeToClientV_3 = CBOR.TInt (3 `setBit` nodeToClientVersionBit)
  encodeTerm NodeToClientV_4 = CBOR.TInt (4 `setBit` nodeToClientVersionBit)
+ encodeTerm NodeToClientV_5 = CBOR.TInt (5 `setBit` nodeToClientVersionBit)
+ encodeTerm NodeToClientV_6 = CBOR.TInt (6 `setBit` nodeToClientVersionBit)
 
  decodeTerm (CBOR.TInt tag) =
  case ( tag `clearBit` nodeToClientVersionBit
@@ -56,6 +62,8 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
  (2, True) -> Right NodeToClientV_2
  (3, True) -> Right NodeToClientV_3
  (4, True) -> Right NodeToClientV_4
+ (5, True) -> Right NodeToClientV_5
+ (6, True) -> Right NodeToClientV_6
  (n, _) -> Left ( T.pack "decode NodeToClientVersion: unknown tag: " <> T.pack (show tag)
  , Just n)
  decodeTerm _ = Left ( T.pack "decode NodeToClientVersion: unexpected term"

ouroboros-network/src/Ouroboros/Network/NodeToNode/Version.hs

@@ -31,16 +31,20 @@ data NodeToNodeVersion
  --
  -- * Enable block size hints for Byron headers in ChainSync
  -- * Enable Keep-Alive miniprotocol
- -- * Enable @CardanoNodeToNodeVersion2@
+ -- * Enable @CardanoNodeToNodeVersion2@, i.e., Shelley
  | NodeToNodeV_3
  -- ^ Changes:
  --
  -- * Enable KeepAlive miniprotocol
  | NodeToNodeV_4
  -- ^ Changes:
  --
- -- * Added 'DiffusionMode' Handshake argument. Also from this version up
- -- the node will use duplex connections.
+ -- * Added 'DiffusionMode' Handshake argument.
+ -- * Enable @CardanoNodeToNodeVersion3@, i.e., Allegra
+ | NodeToNodeV_5
+ -- ^ Changes:
+ --
+ -- * Enable @CardanoNodeToNodeVersion4@, i.e., Mary
  deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
@@ -50,11 +54,13 @@ nodeToNodeVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
  encodeTerm NodeToNodeV_2 = CBOR.TInt 2
  encodeTerm NodeToNodeV_3 = CBOR.TInt 3
  encodeTerm NodeToNodeV_4 = CBOR.TInt 4
+ encodeTerm NodeToNodeV_5 = CBOR.TInt 5
 
  decodeTerm (CBOR.TInt 1) = Right NodeToNodeV_1
  decodeTerm (CBOR.TInt 2) = Right NodeToNodeV_2
  decodeTerm (CBOR.TInt 3) = Right NodeToNodeV_3
  decodeTerm (CBOR.TInt 4) = Right NodeToNodeV_4
+ decodeTerm (CBOR.TInt 5) = Right NodeToNodeV_5
  decodeTerm (CBOR.TInt n) = Left ( T.pack "decode NodeToNodeVersion: unknonw tag: "
  <> T.pack (show n)
  , Just n