Merge #3765

3765: Add Vasil hardfork to cardano-api and cardano-cli r=Jimbo4350 a=Jimbo4350 This PR only introduces the era. It does not begin to integrate the new functionality exposed by `cardano-ledger`. Co-authored-by: Jordan Millar <[email protected]> Co-authored-by: MarcFontaine <[email protected]>
IntersectMBO · Apr 6, 2022 · 8b6f251 · 8b6f251
2 parents 50228f9 + 3f19137
commit 8b6f251
Show file tree

Hide file tree

Showing 25 changed files with 375 additions and 38 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs
@@ -57,6 +57,7 @@ assumeMapCosts _proxy = stepFunction [
       ShelleyBasedEraMary    -> 39
  -- Unconfirmed ! update when alonzo is runnable.
       ShelleyBasedEraAlonzo  -> error "39"
+      ShelleyBasedEraBabbage -> error "39"
 
 -- Bytestring costs are not LINEAR !!
 -- Costs are piecewise linear for payload sizes [0..23] and [24..64].
@@ -127,6 +128,7 @@ metadataInEra (Just m) = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxMetadataInEra TxMetadataInAllegraEra m
   ShelleyBasedEraMary    -> TxMetadataInEra TxMetadataInMaryEra m
   ShelleyBasedEraAlonzo  -> TxMetadataInEra TxMetadataInAlonzoEra m
+  ShelleyBasedEraBabbage -> TxMetadataInEra TxMetadataInBabbageEra m
 
 mkMetadata :: forall era . IsShelleyBasedEra era => Int -> Either String (TxMetadataInEra era)
 mkMetadata 0 = Right $ metadataInEra Nothing
@@ -140,6 +142,7 @@ mkMetadata size
     ShelleyBasedEraAllegra -> 39
     ShelleyBasedEraMary    -> 39
     ShelleyBasedEraAlonzo  -> 39 -- TODO: check minSize for Alonzo
+    ShelleyBasedEraBabbage -> 39 -- TODO: check minSize for Babbage
   nettoSize = size - minSize
 
   -- At 24 the CBOR representation changes.

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs
@@ -196,6 +196,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
     (ShelleyBasedEraAllegra, ShelleyTx _ tx') -> GenTxAllegra (mkShelleyTx tx')
     (ShelleyBasedEraMary, ShelleyTx _ tx') -> GenTxMary (mkShelleyTx tx')
     (ShelleyBasedEraAlonzo, ShelleyTx _ tx') -> GenTxAlonzo (mkShelleyTx tx')
+    (ShelleyBasedEraBabbage, ShelleyTx _ _tx') -> error "TODO:Babbage"
 
   fromGenTxId :: GenTxId CardanoBlock -> TxId
   fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs
@@ -86,12 +86,14 @@ mkGenesisTransaction key _payloadSize ttl fee txins txouts
     ShelleyBasedEraAllegra -> TxFeeExplicit TxFeesExplicitInAllegraEra fee
     ShelleyBasedEraMary    -> TxFeeExplicit TxFeesExplicitInMaryEra fee
     ShelleyBasedEraAlonzo  -> TxFeeExplicit TxFeesExplicitInAlonzoEra fee
+    ShelleyBasedEraBabbage -> TxFeeExplicit TxFeesExplicitInBabbageEra fee
   validityUpperBound = case shelleyBasedEra @ era of
     ShelleyBasedEraShelley -> TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl
     ShelleyBasedEraAllegra -> TxValidityUpperBound ValidityUpperBoundInAllegraEra ttl
     ShelleyBasedEraMary    -> TxValidityUpperBound ValidityUpperBoundInMaryEra ttl
     ShelleyBasedEraAlonzo  -> TxValidityUpperBound ValidityUpperBoundInAlonzoEra ttl
-
+    ShelleyBasedEraBabbage -> TxValidityUpperBound ValidityUpperBoundInBabbageEra ttl
+
 mkTransaction :: forall era .
      IsShelleyBasedEra era
   => SigningKey PaymentKey
@@ -132,6 +134,7 @@ mkFee f = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxFeeExplicit TxFeesExplicitInAllegraEra f
   ShelleyBasedEraMary    -> TxFeeExplicit TxFeesExplicitInMaryEra f
   ShelleyBasedEraAlonzo  -> TxFeeExplicit TxFeesExplicitInAlonzoEra f
+  ShelleyBasedEraBabbage -> TxFeeExplicit TxFeesExplicitInBabbageEra f  
 
 mkValidityUpperBound :: forall era .
      IsShelleyBasedEra era
@@ -142,6 +145,7 @@ mkValidityUpperBound ttl = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxValidityUpperBound ValidityUpperBoundInAllegraEra ttl
   ShelleyBasedEraMary    -> TxValidityUpperBound ValidityUpperBoundInMaryEra ttl
   ShelleyBasedEraAlonzo  -> TxValidityUpperBound ValidityUpperBoundInAlonzoEra ttl
+  ShelleyBasedEraBabbage -> TxValidityUpperBound ValidityUpperBoundInBabbageEra ttl
 
 mkTransactionGen :: forall era .
      IsShelleyBasedEra era
@@ -206,7 +210,8 @@ mkTxOutValueAdaOnly l = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxOutAdaOnly AdaOnlyInAllegraEra l
   ShelleyBasedEraMary    -> TxOutValue MultiAssetInMaryEra $ lovelaceToValue l
   ShelleyBasedEraAlonzo  -> TxOutValue MultiAssetInAlonzoEra $ lovelaceToValue l
-
+  ShelleyBasedEraBabbage -> TxOutValue MultiAssetInBabbageEra $ lovelaceToValue l
+
 txOutValueToLovelace :: TxOutValue era -> Lovelace
 txOutValueToLovelace = \case
   TxOutAdaOnly AdaOnlyInByronEra   x -> x
@@ -222,3 +227,4 @@ txInModeCardano tx = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxInMode tx AllegraEraInCardanoMode
   ShelleyBasedEraMary    -> TxInMode tx MaryEraInCardanoMode
   ShelleyBasedEraAlonzo  -> TxInMode tx AlonzoEraInCardanoMode
+  ShelleyBasedEraBabbage -> TxInMode tx BabbageEraInCardanoMode
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -66,6 +66,7 @@ withEra :: (forall era. IsShelleyBasedEra era => AsType era -> ActionM x) -> Act
 withEra action = do
   era <- get $ User TEra
   case era of
+    AnyCardanoEra BabbageEra -> action AsBabbageEra    
     AnyCardanoEra AlonzoEra  -> action AsAlonzoEra
     AnyCardanoEra MaryEra    -> action AsMaryEra
     AnyCardanoEra AllegraEra -> action AsAllegraEra

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs
@@ -172,6 +172,7 @@ genTx protocolParameters (collateral, collFunds) fee metadata witness inFunds ou
     ShelleyBasedEraAllegra -> TxValidityNoUpperBound ValidityNoUpperBoundInAllegraEra
     ShelleyBasedEraMary    -> TxValidityNoUpperBound ValidityNoUpperBoundInMaryEra
     ShelleyBasedEraAlonzo  -> TxValidityNoUpperBound ValidityNoUpperBoundInAlonzoEra
+    ShelleyBasedEraBabbage -> TxValidityNoUpperBound ValidityNoUpperBoundInBabbageEra
 
 newtype WalletScript era = WalletScript { runWalletScript :: IO (WalletStep era) }
 
@@ -232,3 +233,4 @@ mkTxOutValueAdaOnly l = case shelleyBasedEra @ era of
   ShelleyBasedEraAllegra -> TxOutAdaOnly AdaOnlyInAllegraEra l
   ShelleyBasedEraMary    -> TxOutValue MultiAssetInMaryEra $ lovelaceToValue l
   ShelleyBasedEraAlonzo  -> TxOutValue MultiAssetInAlonzoEra $ lovelaceToValue l
+  ShelleyBasedEraBabbage -> TxOutValue MultiAssetInBabbageEra $ lovelaceToValue l
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -104,6 +104,7 @@ library
                       , cardano-crypto-wrapper
                       , cardano-data
                       , cardano-ledger-alonzo
+                      , cardano-ledger-babbage
                       , cardano-ledger-byron
                       , cardano-ledger-core
                       , cardano-ledger-shelley-ma

diff --git a/cardano-api/gen/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Gen/Cardano/Api/Typed.hs
@@ -783,6 +783,7 @@ genTxOutDatumHash era = case era of
                     , TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
                     , TxOutDatum     ScriptDataInAlonzoEra <$> genScriptData
                     ]
+    BabbageEra -> pure TxOutDatumNone -- TODO: Babbage Era
 
 mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a
 mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR

diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs
@@ -147,6 +147,12 @@ instance Show (Block era) where
         . showsPrec 11 block
         )
 
+    showsPrec p (ShelleyBlock ShelleyBasedEraBabbage _block) =
+      showParen (p >= 11)
+        ( showString "ShelleyBlock ShelleyBasedEraBabbage "
+        . error "TODO: Babbage era" --showsPrec 11 block
+        )
+
 getBlockTxs :: forall era . Block era -> [Tx era]
 getBlockTxs (ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw }) =
     case byronBlockRaw of
@@ -180,6 +186,7 @@ obtainConsensusShelleyBasedEra ShelleyBasedEraShelley f = f
 obtainConsensusShelleyBasedEra ShelleyBasedEraAllegra f = f
 obtainConsensusShelleyBasedEra ShelleyBasedEraMary    f = f
 obtainConsensusShelleyBasedEra ShelleyBasedEraAlonzo  f = f
+obtainConsensusShelleyBasedEra ShelleyBasedEraBabbage _f = error "TODO: Babbage era"
 
 
 -- ----------------------------------------------------------------------------
@@ -245,6 +252,7 @@ toConsensusBlock bInMode =
     BlockInMode (ShelleyBlock ShelleyBasedEraAllegra b') AllegraEraInCardanoMode -> Consensus.BlockAllegra b'
     BlockInMode (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b'
     BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b'
+    BlockInMode (ShelleyBlock ShelleyBasedEraBabbage _b') BabbageEraInCardanoMode -> error "TODO: Babbage"
 
 -- ----------------------------------------------------------------------------
 -- Block headers
@@ -281,6 +289,7 @@ getBlockHeader (ShelleyBlock shelleyEra block) = case shelleyEra of
   ShelleyBasedEraAllegra -> go
   ShelleyBasedEraMary -> go
   ShelleyBasedEraAlonzo -> go
+  ShelleyBasedEraBabbage -> error "TODO: Babbage era"
   where
     go :: Consensus.ShelleyBasedEra (ShelleyLedgerEra era) => BlockHeader
     go = BlockHeader headerFieldSlot (HeaderHash hashSBS) headerFieldBlockNo

diff --git a/cardano-api/src/Cardano/Api/Eras.hs b/cardano-api/src/Cardano/Api/Eras.hs
@@ -14,6 +14,7 @@ module Cardano.Api.Eras
   , AllegraEra
   , MaryEra
   , AlonzoEra
+  , BabbageEra
   , CardanoEra(..)
   , IsCardanoEra(..)
   , AnyCardanoEra(..)
@@ -25,6 +26,7 @@ module Cardano.Api.Eras
   , Shelley
   , Allegra
   , Mary
+  , Babbage
 
     -- * Shelley-based eras
   , ShelleyBasedEra(..)
@@ -40,8 +42,8 @@ module Cardano.Api.Eras
   , cardanoEraStyle
 
     -- * Data family instances
-  , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra,
-           AsByron,    AsShelley,    AsAllegra,    AsMary)
+  , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra,
+           AsByron,    AsShelley,    AsAllegra,    AsMary,    AsAlonzo,    AsBabbage)
   ) where
 
 import           Prelude
@@ -51,7 +53,9 @@ import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 
 import           Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardAlonzo,
-                   StandardMary, StandardShelley)
+                   StandardCrypto, StandardMary, StandardShelley)
+
+import qualified Cardano.Ledger.Babbage as Babbage
 
 import           Cardano.Api.HasTypeProxy
 
@@ -71,6 +75,9 @@ data MaryEra
 -- | A type used as a tag to distinguish the Alonzo era.
 data AlonzoEra
 
+-- | A type used as a tag to distinguish the Babbage era.
+data BabbageEra
+
 instance HasTypeProxy ByronEra where
     data AsType ByronEra = AsByronEra
     proxyToAsType _ = AsByronEra
@@ -91,6 +98,9 @@ instance HasTypeProxy AlonzoEra where
     data AsType AlonzoEra = AsAlonzoEra
     proxyToAsType _ = AsAlonzoEra
 
+instance HasTypeProxy BabbageEra where
+   data AsType BabbageEra = AsBabbageEra
+   proxyToAsType _ = AsBabbageEra
 
 -- ----------------------------------------------------------------------------
 -- Deprecated aliases
@@ -100,6 +110,7 @@ type Byron   = ByronEra
 type Shelley = ShelleyEra
 type Allegra = AllegraEra
 type Mary    = MaryEra
+type Babbage = BabbageEra
 
 {-# DEPRECATED Byron   "Use 'ByronEra' or 'ByronAddr' as appropriate" #-}
 {-# DEPRECATED Shelley "Use 'ShelleyEra' or 'ShelleyAddr' as appropriate" #-}
@@ -118,6 +129,13 @@ pattern AsAllegra  = AsAllegraEra
 pattern AsMary    :: AsType MaryEra
 pattern AsMary     = AsMaryEra
 
+
+pattern AsAlonzo  :: AsType AlonzoEra
+pattern AsAlonzo   = AsAlonzoEra
+
+pattern AsBabbage :: AsType BabbageEra
+pattern AsBabbage  = AsBabbageEra
+
 {-# DEPRECATED AsByron   "Use 'AsByronEra' instead" #-}
 {-# DEPRECATED AsShelley "Use 'AsShelleyEra' instead" #-}
 {-# DEPRECATED AsAllegra "Use 'AsAllegraEra' instead" #-}
@@ -143,6 +161,7 @@ data CardanoEra era where
      AllegraEra :: CardanoEra AllegraEra
      MaryEra    :: CardanoEra MaryEra
      AlonzoEra  :: CardanoEra AlonzoEra
+     BabbageEra :: CardanoEra BabbageEra
      -- when you add era here, change `instance Bounded AnyCardanoEra`
 
 deriving instance Eq   (CardanoEra era)
@@ -155,13 +174,15 @@ instance ToJSON (CardanoEra era) where
    toJSON AllegraEra = "Allegra"
    toJSON MaryEra    = "Mary"
    toJSON AlonzoEra  = "Alonzo"
+   toJSON BabbageEra = "Babbage"
 
 instance TestEquality CardanoEra where
     testEquality ByronEra   ByronEra   = Just Refl
     testEquality ShelleyEra ShelleyEra = Just Refl
     testEquality AllegraEra AllegraEra = Just Refl
     testEquality MaryEra    MaryEra    = Just Refl
     testEquality AlonzoEra  AlonzoEra  = Just Refl
+    testEquality BabbageEra BabbageEra = Just Refl
     testEquality _          _          = Nothing
 
 
@@ -187,6 +208,10 @@ instance IsCardanoEra MaryEra where
 instance IsCardanoEra AlonzoEra where
    cardanoEra      = AlonzoEra
 
+instance IsCardanoEra BabbageEra where
+   cardanoEra      = BabbageEra
+
+
 data AnyCardanoEra where
      AnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
                    => CardanoEra era    -- and explicit value.
@@ -202,26 +227,28 @@ instance Eq AnyCardanoEra where
 
 instance Bounded AnyCardanoEra where
    minBound = AnyCardanoEra ByronEra
-   maxBound = AnyCardanoEra AlonzoEra
+   maxBound = AnyCardanoEra BabbageEra
 
 instance Enum AnyCardanoEra where
 
    -- [e..] = [e..maxBound]
    enumFrom e = enumFromTo e maxBound
 
    fromEnum = \case
-      AnyCardanoEra ByronEra   -> 0
-      AnyCardanoEra ShelleyEra -> 1
-      AnyCardanoEra AllegraEra -> 2
-      AnyCardanoEra MaryEra    -> 3
-      AnyCardanoEra AlonzoEra  -> 4
+      AnyCardanoEra ByronEra    -> 0
+      AnyCardanoEra ShelleyEra  -> 1
+      AnyCardanoEra AllegraEra  -> 2
+      AnyCardanoEra MaryEra     -> 3
+      AnyCardanoEra AlonzoEra   -> 4
+      AnyCardanoEra BabbageEra  -> 5
 
    toEnum = \case
       0 -> AnyCardanoEra ByronEra
       1 -> AnyCardanoEra ShelleyEra
       2 -> AnyCardanoEra AllegraEra
       3 -> AnyCardanoEra MaryEra
       4 -> AnyCardanoEra AlonzoEra
+      5 -> AnyCardanoEra BabbageEra
       n ->
          error $
             "AnyCardanoEra.toEnum: " <> show n
@@ -238,6 +265,7 @@ instance FromJSON AnyCardanoEra where
         "Allegra" -> pure $ AnyCardanoEra AllegraEra
         "Mary" -> pure $ AnyCardanoEra MaryEra
         "Alonzo" -> pure $ AnyCardanoEra AlonzoEra
+        "Babbage" -> pure $ AnyCardanoEra BabbageEra
         wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong
 
 
@@ -250,6 +278,7 @@ anyCardanoEra ShelleyEra = AnyCardanoEra ShelleyEra
 anyCardanoEra AllegraEra = AnyCardanoEra AllegraEra
 anyCardanoEra MaryEra    = AnyCardanoEra MaryEra
 anyCardanoEra AlonzoEra  = AnyCardanoEra AlonzoEra
+anyCardanoEra BabbageEra = AnyCardanoEra BabbageEra
 
 -- | This pairs up some era-dependent type with a 'CardanoEra' value that tells
 -- us what era it is, but hides the era type. This is useful when the era is
@@ -279,6 +308,7 @@ data ShelleyBasedEra era where
      ShelleyBasedEraAllegra :: ShelleyBasedEra AllegraEra
      ShelleyBasedEraMary    :: ShelleyBasedEra MaryEra
      ShelleyBasedEraAlonzo  :: ShelleyBasedEra AlonzoEra
+     ShelleyBasedEraBabbage :: ShelleyBasedEra BabbageEra
 
 deriving instance Eq   (ShelleyBasedEra era)
 deriving instance Ord  (ShelleyBasedEra era)
@@ -303,6 +333,10 @@ instance IsShelleyBasedEra MaryEra where
 instance IsShelleyBasedEra AlonzoEra where
    shelleyBasedEra = ShelleyBasedEraAlonzo
 
+
+instance IsShelleyBasedEra BabbageEra where
+   shelleyBasedEra = ShelleyBasedEraBabbage
+
 -- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that
 -- tells us what era it is, but hides the era type. This is useful when the era
 -- is not statically known, for example when deserialising from a file.
@@ -320,7 +354,7 @@ shelleyBasedToCardanoEra ShelleyBasedEraShelley = ShelleyEra
 shelleyBasedToCardanoEra ShelleyBasedEraAllegra = AllegraEra
 shelleyBasedToCardanoEra ShelleyBasedEraMary    = MaryEra
 shelleyBasedToCardanoEra ShelleyBasedEraAlonzo  = AlonzoEra
-
+shelleyBasedToCardanoEra ShelleyBasedEraBabbage = BabbageEra
 
 -- ----------------------------------------------------------------------------
 -- Cardano eras factored as Byron vs Shelley-based
@@ -352,6 +386,7 @@ cardanoEraStyle ShelleyEra = ShelleyBasedEra ShelleyBasedEraShelley
 cardanoEraStyle AllegraEra = ShelleyBasedEra ShelleyBasedEraAllegra
 cardanoEraStyle MaryEra    = ShelleyBasedEra ShelleyBasedEraMary
 cardanoEraStyle AlonzoEra  = ShelleyBasedEra ShelleyBasedEraAlonzo
+cardanoEraStyle BabbageEra = ShelleyBasedEra ShelleyBasedEraBabbage
 
 
 -- ----------------------------------------------------------------------------
@@ -371,3 +406,5 @@ type family ShelleyLedgerEra era where
   ShelleyLedgerEra AllegraEra = Ledger.StandardAllegra
   ShelleyLedgerEra MaryEra    = Ledger.StandardMary
   ShelleyLedgerEra AlonzoEra  = Ledger.StandardAlonzo
+  ShelleyLedgerEra BabbageEra = Babbage.BabbageEra StandardCrypto
+