Merge #3765

3765: Add Vasil era 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]>
IntersectMBO · Apr 5, 2022 · 6388ea2 · 6388ea2
2 parents cbb97f3 + fdd304a
commit 6388ea2
Show file tree

Hide file tree

Showing 20 changed files with 364 additions and 44 deletions.
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
+
diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs
@@ -139,6 +139,7 @@ transactionFee txFeeFixed txFeePerByte tx =
   obtainHasField ShelleyBasedEraAllegra f = f
   obtainHasField ShelleyBasedEraMary    f = f
   obtainHasField ShelleyBasedEraAlonzo  f = f
+  obtainHasField ShelleyBasedEraBabbage f = f
 
 {-# DEPRECATED transactionFee "Use 'evaluateTransactionFee' instead" #-}
 
@@ -266,6 +267,7 @@ evaluateTransactionFee pparams txbody keywitcount _byronwitcount =
     withLedgerConstraints ShelleyBasedEraAllegra f = f
     withLedgerConstraints ShelleyBasedEraMary    f = f
     withLedgerConstraints ShelleyBasedEraAlonzo  f = f
+    withLedgerConstraints ShelleyBasedEraBabbage f = f
 
 -- | Give an approximate count of the number of key witnesses (i.e. signatures)
 -- a transaction will need.
@@ -484,6 +486,7 @@ evaluateTransactionExecutionUnits _eraInMode systemstart history pparams utxo tx
           ShelleyBasedEraAllegra -> evalPreAlonzo
           ShelleyBasedEraMary    -> evalPreAlonzo
           ShelleyBasedEraAlonzo  -> evalAlonzo era tx'
+          ShelleyBasedEraBabbage -> error "TODO: Babbage"
   where
     -- Pre-Alonzo eras do not support languages with execution unit accounting.
     evalPreAlonzo :: Either TransactionValidityError
@@ -637,10 +640,11 @@ evaluateTransactionBalance pparams poolids utxo
           => MultiAssetSupportedInEra era
           -> a)
       -> a
-    withLedgerConstraints ShelleyBasedEraShelley f _ = f AdaOnlyInShelleyEra
-    withLedgerConstraints ShelleyBasedEraAllegra f _ = f AdaOnlyInAllegraEra
-    withLedgerConstraints ShelleyBasedEraMary    _ f = f MultiAssetInMaryEra
-    withLedgerConstraints ShelleyBasedEraAlonzo  _ f = f MultiAssetInAlonzoEra
+    withLedgerConstraints ShelleyBasedEraShelley f _  = f AdaOnlyInShelleyEra
+    withLedgerConstraints ShelleyBasedEraAllegra f _  = f AdaOnlyInAllegraEra
+    withLedgerConstraints ShelleyBasedEraMary    _ f  = f MultiAssetInMaryEra
+    withLedgerConstraints ShelleyBasedEraAlonzo  _ f  = f MultiAssetInAlonzoEra
+    withLedgerConstraints ShelleyBasedEraBabbage _ _f = error "TODO: Babbage"
 
 type LedgerEraConstraints ledgerera =
        ( Ledger.Era.Crypto ledgerera ~ Ledger.StandardCrypto
@@ -1031,6 +1035,7 @@ calculateMinimumUTxO era txout@(TxOut _ v _) pparams' =
           Right . lovelaceToValue
             $ Lovelace (Alonzo.utxoEntrySize (toShelleyTxOutAny era txout) * costPerWord)
         Nothing -> Left PParamsUTxOCostPerWordMissing
+    ShelleyBasedEraBabbage -> error "TODO: Babbage"
  where
    calcMinUTxOAllegraMary :: Either MinimumUTxOError Value
    calcMinUTxOAllegraMary = do

diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs
@@ -116,9 +116,10 @@ import qualified Cardano.Ledger.Crypto as Crypto
 import qualified Cardano.Ledger.Era as Ledger
 import qualified Cardano.Ledger.Keys as Shelley.Spec
 import qualified Cardano.Ledger.Shelley.API as ShelleyAPI
-import qualified Cardano.Protocol.TPraos.API as TPraos
 import qualified Cardano.Ledger.Shelley.Genesis as Shelley.Spec
+import qualified Cardano.Protocol.TPraos.API as TPraos
 import qualified Cardano.Protocol.TPraos.BHeader as TPraos
+import qualified Cardano.Protocol.TPraos.Rules.Prtcl as TPraos
 import qualified Cardano.Protocol.TPraos.Rules.Tickn as Tick
 import           Cardano.Slotting.EpochInfo (EpochInfo)
 import qualified Cardano.Slotting.EpochInfo.API as Slot
@@ -151,7 +152,6 @@ import qualified Ouroboros.Network.Block
 import qualified Ouroboros.Network.Protocol.ChainSync.Client as CS
 import qualified Ouroboros.Network.Protocol.ChainSync.ClientPipelined as CSP
 import           Ouroboros.Network.Protocol.ChainSync.PipelineDecision
-import qualified Cardano.Protocol.TPraos.Rules.Prtcl as TPraos
 
 data InitialLedgerStateError
   = ILSEConfigFile Text
@@ -231,6 +231,7 @@ applyBlock env oldState validationMode block
         ShelleyBasedEraAllegra -> Consensus.BlockAllegra shelleyBlock
         ShelleyBasedEraMary    -> Consensus.BlockMary shelleyBlock
         ShelleyBasedEraAlonzo  -> Consensus.BlockAlonzo shelleyBlock
+        ShelleyBasedEraBabbage -> error "TODO: Babbage era"
 
 pattern LedgerStateByron
   :: Ledger.LedgerState Byron.ByronBlock
@@ -1417,6 +1418,7 @@ obtainIsStandardCrypto ShelleyBasedEraShelley f = f
 obtainIsStandardCrypto ShelleyBasedEraAllegra f = f
 obtainIsStandardCrypto ShelleyBasedEraMary    f = f
 obtainIsStandardCrypto ShelleyBasedEraAlonzo  f = f
+obtainIsStandardCrypto ShelleyBasedEraBabbage f = f
 
 
 obtainDecodeEpochStateConstraints
@@ -1431,6 +1433,7 @@ obtainDecodeEpochStateConstraints ShelleyBasedEraShelley f = f
 obtainDecodeEpochStateConstraints ShelleyBasedEraAllegra f = f
 obtainDecodeEpochStateConstraints ShelleyBasedEraMary    f = f
 obtainDecodeEpochStateConstraints ShelleyBasedEraAlonzo  f = f
+obtainDecodeEpochStateConstraints ShelleyBasedEraBabbage f = f
 
 -- | Return the slots at which a particular stake pool operator is
 -- expected to mint a block.