PROTOTYPE: Babel Fees with EraFirstRule workaround

cabal.project

@@ -28,6 +28,8 @@ packages:
   eras/alonzo/test-suite
   eras/babbage/impl
   eras/babbage/test-suite
+  eras/babel/impl
+  eras/babel/test-suite
   eras/conway/impl
   eras/conway/test-suite
   eras/mary/impl
@@ -85,6 +87,9 @@ package cardano-ledger-mary
 package cardano-ledger-conway
   flags: +asserts
 
+package cardano-ledger-babel
+  flags: +asserts
+
 -- Always write GHC env files, because they are needed for repl and by the doctests.
 write-ghc-environment-files: always
 
@@ -94,3 +99,16 @@ benchmarks: true
 
 -- The only sensible test display option
 test-show-details: streaming
+
+
+source-repository-package
+  type: git
+  location: https://github.com/willjgould/plutus
+  tag: a5179ce32b3471399d35b621920901643544c200
+  --sha256: 0ksz9q2j07kqf1pl3lyccjfkvxs0dyd0y6pn4ish9mfcgh6afsph
+  subdir:
+    plutus-ledger-api
+    plutus-tx
+    plutus-tx-plugin
+    plutus-core
+    prettyprinter-configurable

eras/allegra/impl/src/Cardano/Ledger/Allegra.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 -- CanStartFromGenesis
 {-# OPTIONS_GHC -Wno-deprecations #-}

eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs

@@ -13,7 +13,7 @@ module Cardano.Ledger.Allegra.Era (
 
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.Shelley (ShelleyEra)
+import Cardano.Ledger.Shelley (EraFirstRule, ShelleyEra)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.Rules
 
@@ -27,6 +27,8 @@ instance Crypto c => Era (AllegraEra c) where
 
   eraName = "Allegra"
 
+type instance EraFirstRule (AllegraEra c) = "LEDGERS"
+
 --------------------------------------------------------------------------------
 -- Core instances
 --------------------------------------------------------------------------------

eras/allegra/impl/src/Cardano/Ledger/Allegra/TxSeq.hs

@@ -15,11 +15,14 @@ import Cardano.Ledger.Allegra.Tx ()
 import Cardano.Ledger.Core (EraSegWits (..))
 import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import Cardano.Ledger.Shelley.BlockChain (ShelleyTxSeq (..), bbHash, txSeqTxns)
+import qualified Data.Sequence.Strict as StrictSeq
 
 instance Crypto c => EraSegWits (AllegraEra c) where
   {-# SPECIALIZE instance EraSegWits (AllegraEra StandardCrypto) #-}
-  type TxSeq (AllegraEra c) = ShelleyTxSeq (AllegraEra c)
-  fromTxSeq = txSeqTxns
-  toTxSeq = ShelleyTxSeq
-  hashTxSeq = bbHash
+  type TxStructure (AllegraEra c) = StrictSeq.StrictSeq
+  type TxZones (AllegraEra c) = ShelleyTxSeq (AllegraEra c)
+  fromTxZones = txSeqTxns
+  toTxZones = ShelleyTxSeq
+  flatten = txSeqTxns
+  hashTxZones = bbHash
   numSegComponents = 3

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Test.Cardano.Ledger.Allegra.Imp (spec) where
 
@@ -13,8 +14,8 @@ import qualified Test.Cardano.Ledger.Shelley.Imp as ShelleyImp
 import Test.Cardano.Ledger.Shelley.ImpTest (ShelleyEraImp)
 
 spec ::
-  forall era.
-  ( ShelleyEraImp era
+  forall era ls.
+  ( ShelleyEraImp ls era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   ) =>

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -18,6 +20,7 @@ import Cardano.Ledger.Allegra.Core
 import Cardano.Ledger.Allegra.Scripts (Timelock (..))
 import Cardano.Ledger.Crypto (Crypto (..))
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
+import Cardano.Ledger.Shelley.LedgerState (LedgerState)
 import Control.Monad.State.Strict (get)
 import qualified Data.Map.Strict as Map
 import Data.Sequence.Strict (StrictSeq (..))
@@ -35,7 +38,7 @@ instance
   , DSIGN c ~ Ed25519DSIGN
   , Signable (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
   ) =>
-  ShelleyEraImp (AllegraEra c)
+  ShelleyEraImp LedgerState (AllegraEra c)
   where
   initImpTestState = pure ()
 
@@ -44,7 +47,9 @@ instance
   fixupTx = shelleyFixupTx
 
 impAllegraSatisfyNativeScript ::
-  (ShelleyEraImp era, NativeScript era ~ Timelock era) =>
+  ( ShelleyEraImp ls era
+  , NativeScript era ~ Timelock era
+  ) =>
   Set.Set (KeyHash 'Witness (EraCrypto era)) ->
   NativeScript era ->
   ImpTestM era (Maybe (Map.Map (KeyHash 'Witness (EraCrypto era)) (KeyPair 'Witness (EraCrypto era))))

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -90,7 +90,7 @@ library
         mtl,
         microlens,
         nothunks,
-        plutus-ledger-api ^>=1.26.0,
+        plutus-ledger-api ^>=1.30.0.0,
         set-algebra >=1.0,
         small-steps >=1.1,
         text,

eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -47,15 +47,18 @@ import Cardano.Ledger.Shelley.API.Mempool
 import Control.Arrow (left)
 import Control.Monad.Except (MonadError, liftEither)
 import Control.Monad.Reader (runReader)
-import Control.State.Transition.Extended (TRC (TRC))
+import Control.State.Transition.Extended (STS (State), TRC (TRC))
 
 type Alonzo = AlonzoEra StandardCrypto
 
 -- =====================================================
 
 reapplyAlonzoTx ::
   forall era m.
-  (API.ApplyTx era, MonadError (ApplyTxError era) m) =>
+  ( API.ApplyTx era
+  , MonadError (ApplyTxError era) m
+  , State (EraRule "LEDGER" era) ~ API.LedgerState era
+  ) =>
   Globals ->
   MempoolEnv era ->
   MempoolState era ->

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs

@@ -13,6 +13,7 @@ where
 
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Mary (MaryEra, MaryValue)
+import Cardano.Ledger.Shelley (EraFirstRule)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.Rules
 
@@ -31,6 +32,8 @@ instance Crypto c => Era (AlonzoEra c) where
 
 type instance Value (AlonzoEra c) = MaryValue c
 
+type instance EraFirstRule (AlonzoEra c) = "LEDGERS"
+
 -------------------------------------------------------------------------------
 -- Era Mapping
 -------------------------------------------------------------------------------

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -773,6 +773,7 @@ encodeCostModel cm =
     -- we use the 'canonical' serialization with definite list length.
     PlutusV2 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm
     PlutusV3 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm
+    PlutusV4 -> encodeFoldableAsDefLenList encCBOR $ getCostModelParams cm
 
 getLanguageView ::
   AlonzoEraPParams era =>
@@ -787,6 +788,7 @@ getLanguageView pp lang =
         (serialize' version costModelEncoding)
     PlutusV2 -> latestLangDepView
     PlutusV3 -> latestLangDepView
+    PlutusV4 -> latestLangDepView
   where
     -- LangDepView for PlutusV1 differs from the rest
     latestLangDepView = LangDepView (serialize' version lang) costModelEncoding

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/Context.hs

@@ -44,6 +44,7 @@ import qualified PlutusLedgerApi.V1 as P (ToData, toData)
 import qualified PlutusLedgerApi.V1 as PV1
 import qualified PlutusLedgerApi.V2 as PV2
 import qualified PlutusLedgerApi.V3 as PV3
+import qualified PlutusLedgerApi.V4 as PV4
 
 class (PlutusLanguage l, EraPlutusContext era) => EraPlutusTxInfo (l :: Language) era where
   toPlutusTxCert :: proxy l -> TxCert era -> Either (ContextError era) (PlutusTxCert l)
@@ -114,18 +115,22 @@ type family PlutusTxCert (l :: Language) where
   PlutusTxCert 'PlutusV1 = PV1.DCert
   PlutusTxCert 'PlutusV2 = PV2.DCert
   PlutusTxCert 'PlutusV3 = PV3.TxCert
+  PlutusTxCert 'PlutusV4 = PV4.TxCert
 
 type family PlutusScriptPurpose (l :: Language) where
   PlutusScriptPurpose 'PlutusV1 = PV1.ScriptPurpose
   PlutusScriptPurpose 'PlutusV2 = PV2.ScriptPurpose
   PlutusScriptPurpose 'PlutusV3 = PV3.ScriptPurpose
+  PlutusScriptPurpose 'PlutusV4 = PV4.ScriptPurpose
 
 type family PlutusScriptContext (l :: Language) where
   PlutusScriptContext 'PlutusV1 = PV1.ScriptContext
   PlutusScriptContext 'PlutusV2 = PV2.ScriptContext
   PlutusScriptContext 'PlutusV3 = PV3.ScriptContext
+  PlutusScriptContext 'PlutusV4 = PV4.ScriptContext
 
 type family PlutusTxInfo (l :: Language) where
   PlutusTxInfo 'PlutusV1 = PV1.TxInfo
   PlutusTxInfo 'PlutusV2 = PV2.TxInfo
   PlutusTxInfo 'PlutusV3 = PV3.TxInfo
+  PlutusTxInfo 'PlutusV4 = PV4.TxInfo

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -40,6 +40,7 @@ import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Core
 import qualified Cardano.Ledger.Era as Era
 import Cardano.Ledger.Keys (DSignable, Hash, coerceKeyRole)
+import Cardano.Ledger.Shelley (EraFirstRule)
 import Cardano.Ledger.Shelley.BlockChain (incrBlocks)
 import Cardano.Ledger.Shelley.LedgerState (LedgerState)
 import Cardano.Ledger.Shelley.Rules (
@@ -186,10 +187,11 @@ bbodyTransition ::
   , Embed (EraRule "LEDGERS" era) (someBBODY era)
   , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
   , State (EraRule "LEDGERS" era) ~ LedgerState era
+  , State (EraRule (EraFirstRule era) era) ~ LedgerState era
   , Signal (EraRule "LEDGERS" era) ~ Seq (Tx era)
   , EraSegWits era
   , AlonzoEraTxWits era
-  , Era.TxSeq era ~ AlonzoTxSeq era
+  , Era.TxZones era ~ AlonzoTxSeq era
   , Tx era ~ AlonzoTx era
   , AlonzoEraPParams era
   ) =>
@@ -204,7 +206,7 @@ bbodyTransition =
           ) -> do
         let txs = txSeqTxns txsSeq
             actualBodySize = bBodySize (pp ^. ppProtocolVersionL) txsSeq
-            actualBodyHash = hashTxSeq @era txsSeq
+            actualBodyHash = hashTxZones @era txsSeq
 
         actualBodySize
           == fromIntegral (bhviewBSize bh)
@@ -257,10 +259,11 @@ instance
   , Embed (EraRule "LEDGERS" era) (AlonzoBBODY era)
   , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
   , State (EraRule "LEDGERS" era) ~ LedgerState era
+  , State (EraRule (EraFirstRule era) era) ~ LedgerState era
   , Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
   , AlonzoEraTxWits era
   , Tx era ~ AlonzoTx era
-  , Era.TxSeq era ~ AlonzoTxSeq era
+  , Era.TxZones era ~ AlonzoTxSeq era
   , Tx era ~ AlonzoTx era
   , EraSegWits era
   , AlonzoEraPParams era

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs

@@ -539,6 +539,7 @@ encodeScript = \case
       SPlutusV1 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV1) 1 !> To pb
       SPlutusV2 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV2) 2 !> To pb
       SPlutusV3 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV3) 3 !> To pb
+      SPlutusV4 -> Sum (PlutusScript . fromJust . mkPlutusScript . Plutus @'PlutusV4) 4 !> To pb
 
 instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
   decCBOR = decode (Summands "AlonzoScript" decodeScript)
@@ -552,6 +553,7 @@ instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
         1 -> decodeAnnPlutus SPlutusV1
         2 -> decodeAnnPlutus SPlutusV2
         3 -> decodeAnnPlutus SPlutusV3
+        4 -> decodeAnnPlutus SPlutusV4
         n -> Invalid n
       {-# INLINE decodeScript #-}
   {-# INLINE decCBOR #-}

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -15,6 +16,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
@@ -128,7 +130,10 @@ import Cardano.Ledger.MemoBytes (EqRaw (..))
 import Cardano.Ledger.Plutus.Data (Data, hashData)
 import Cardano.Ledger.Plutus.Language (nonNativeLanguages)
 import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash (..), hashAnnotated)
-import Cardano.Ledger.Shelley.Tx (ShelleyTx (ShelleyTx), shelleyEqTxRaw)
+import Cardano.Ledger.Shelley.Tx (
+  ShelleyTx (ShelleyTx),
+  shelleyEqTxRaw,
+ )
 import qualified Cardano.Ledger.UTxO as Shelley
 import Cardano.Ledger.Val (Val ((<+>), (<×>)))
 import Control.Arrow (left)
@@ -215,7 +220,10 @@ instance Crypto c => AlonzoEraTx (AlonzoEra c) where
   isValidTxL = isValidAlonzoTxL
   {-# INLINE isValidTxL #-}
 
-mkBasicAlonzoTx :: Monoid (TxWits era) => TxBody era -> AlonzoTx era
+mkBasicAlonzoTx ::
+  Monoid (TxWits era) =>
+  TxBody era ->
+  AlonzoTx era
 mkBasicAlonzoTx txBody = AlonzoTx txBody mempty (IsValid True) SNothing
 
 -- | `TxBody` setter and getter for `AlonzoTx`.
@@ -248,10 +256,20 @@ isValidAlonzoTxL = lens isValid (\tx valid -> tx {isValid = valid})
 {-# INLINEABLE isValidAlonzoTxL #-}
 
 deriving instance
-  (Era era, Eq (TxBody era), Eq (TxWits era), Eq (TxAuxData era)) => Eq (AlonzoTx era)
+  ( Era era
+  , Eq (TxBody era)
+  , Eq (TxWits era)
+  , Eq (TxAuxData era)
+  ) =>
+  Eq (AlonzoTx era)
 
 deriving instance
-  (Era era, Show (TxBody era), Show (TxAuxData era), Show (Script era), Show (TxWits era)) =>
+  ( Era era
+  , Show (TxBody era)
+  , Show (TxAuxData era)
+  , Show (Script era)
+  , Show (TxWits era)
+  ) =>
   Show (AlonzoTx era)
 
 instance
@@ -405,9 +423,12 @@ alonzoSegwitTx txBodyAnn txWitsAnn isValid auxDataAnn = Annotator $ \bytes ->
       txWits = runAnnotator txWitsAnn bytes
       txAuxData = maybeToStrictMaybe (flip runAnnotator bytes <$> auxDataAnn)
    in mkBasicTx txBody
-        & witsTxL .~ txWits
-        & auxDataTxL .~ txAuxData
-        & isValidTxL .~ isValid
+        & witsTxL
+        .~ txWits
+        & auxDataTxL
+        .~ txAuxData
+        & isValidTxL
+        .~ isValid
 
 --------------------------------------------------------------------------------
 -- Mempool Serialisation

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs

@@ -38,8 +38,7 @@ import Cardano.Ledger.Binary (
   serialize,
   withSlice,
  )
-import Cardano.Ledger.Core hiding (TxSeq, hashTxSeq)
-import qualified Cardano.Ledger.Core as Core
+import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Keys (Hash)
 import Cardano.Ledger.SafeHash (SafeToHash, originalBytes)
@@ -86,10 +85,12 @@ data AlonzoTxSeq era = AlonzoTxSeqRaw
   deriving (Generic)
 
 instance Crypto c => EraSegWits (AlonzoEra c) where
-  type TxSeq (AlonzoEra c) = AlonzoTxSeq (AlonzoEra c)
-  fromTxSeq = txSeqTxns
-  toTxSeq = AlonzoTxSeq
-  hashTxSeq = hashAlonzoTxSeq
+  type TxStructure (AlonzoEra c) = StrictSeq
+  type TxZones (AlonzoEra c) = AlonzoTxSeq (AlonzoEra c)
+  fromTxZones = txSeqTxns
+  toTxZones = AlonzoTxSeq
+  flatten = txSeqTxns
+  hashTxZones = hashAlonzoTxSeq
   numSegComponents = 4
 
 pattern AlonzoTxSeq ::