Switch CurrentEra in ledger-state to Babbage

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

@@ -32,6 +32,7 @@ module Cardano.Ledger.Alonzo.TxOut (
   viewTxOut,
   getAlonzoTxOutEitherAddr,
   utxoEntrySize,
+  internAlonzoTxOut,
 )
 where
 
@@ -373,15 +374,21 @@ instance (Era era, Val (Value era)) => DecCBOR (AlonzoTxOut era) where
 instance (Era era, Val (Value era)) => DecShareCBOR (AlonzoTxOut era) where
   type Share (AlonzoTxOut era) = Interns (Credential 'Staking (EraCrypto era))
   decShareCBOR credsInterns = do
-    let internTxOut = \case
-          TxOut_AddrHash28_AdaOnly cred addr28Extra ada ->
-            TxOut_AddrHash28_AdaOnly (interns credsInterns cred) addr28Extra ada
-          TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada dataHash32 ->
-            TxOut_AddrHash28_AdaOnly_DataHash32 (interns credsInterns cred) addr28Extra ada dataHash32
-          txOut -> txOut
-    internTxOut <$!> decCBOR
+    internAlonzoTxOut (interns credsInterns) <$!> decCBOR
   {-# INLINEABLE decShareCBOR #-}
 
+internAlonzoTxOut ::
+  (Credential 'Staking (EraCrypto era) -> Credential 'Staking (EraCrypto era)) ->
+  AlonzoTxOut era ->
+  AlonzoTxOut era
+internAlonzoTxOut internCred = \case
+  TxOut_AddrHash28_AdaOnly cred addr28Extra ada ->
+    TxOut_AddrHash28_AdaOnly (internCred cred) addr28Extra ada
+  TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada dataHash32 ->
+    TxOut_AddrHash28_AdaOnly_DataHash32 (internCred cred) addr28Extra ada dataHash32
+  txOut -> txOut
+{-# INLINE internAlonzoTxOut #-}
+
 instance (Era era, Val (Value era)) => ToCBOR (AlonzoTxOut era) where
   toCBOR = toEraCBOR @era
   {-# INLINE toCBOR #-}

eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs

@@ -37,6 +37,7 @@ module Cardano.Ledger.Babbage.TxOut (
   txOutData,
   txOutDataHash,
   txOutScript,
+  internBabbageTxOut,
 ) where
 
 import Cardano.Crypto.Hash (HashAlgorithm)
@@ -455,16 +456,21 @@ instance (EraScript era, Val (Value era)) => DecShareCBOR (BabbageTxOut era) whe
     -- Even in Babbage the ledger state still contains garbage pointers that we need to
     -- deal with. This will be taken care of upon entry to Conway era. After which this
     -- backwards compatibility shim can be removed.
-    internTxOut <$!> decodeBabbageTxOut fromCborBackwardsBothAddr
-    where
-      internTxOut = \case
-        TxOut_AddrHash28_AdaOnly cred addr28Extra ada ->
-          TxOut_AddrHash28_AdaOnly (interns credsInterns cred) addr28Extra ada
-        TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada dataHash32 ->
-          TxOut_AddrHash28_AdaOnly_DataHash32 (interns credsInterns cred) addr28Extra ada dataHash32
-        txOut -> txOut
+    internBabbageTxOut (interns credsInterns) <$!> decodeBabbageTxOut fromCborBackwardsBothAddr
   {-# INLINEABLE decShareCBOR #-}
 
+internBabbageTxOut ::
+  (Credential 'Staking (EraCrypto era) -> Credential 'Staking (EraCrypto era)) ->
+  BabbageTxOut era ->
+  BabbageTxOut era
+internBabbageTxOut internCred = \case
+  TxOut_AddrHash28_AdaOnly cred addr28Extra ada ->
+    TxOut_AddrHash28_AdaOnly (internCred cred) addr28Extra ada
+  TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada dataHash32 ->
+    TxOut_AddrHash28_AdaOnly_DataHash32 (internCred cred) addr28Extra ada dataHash32
+  txOut -> txOut
+{-# INLINE internBabbageTxOut #-}
+
 decodeBabbageTxOut ::
   (EraScript era, Val (Value era)) =>
   -- | We need to use a backwards compatible decoder for any address in a pre-babbage

eras/byron/ledger/impl/src/Cardano/Chain/Update/Proposal.hs

@@ -59,7 +59,7 @@ import Cardano.Crypto (
   serializeCborHash,
  )
 import Cardano.Ledger.Binary (
-  Annotated (..),
+  Annotated (Annotated, unAnnotated),
   ByteSpan,
   DecCBOR (..),
   Decoded (..),

eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs

@@ -110,5 +110,4 @@ type instance EraRule "SNAP" (ConwayEra c) = ShelleySNAP (ConwayEra c)
 
 type instance EraRule "TICK" (ConwayEra c) = ShelleyTICK (ConwayEra c)
 
-
 -- =================================================

hie.yaml

@@ -150,6 +150,9 @@ cradle:
     - path: "libs/cardano-ledger-api/src"
       component: "lib:cardano-ledger-api"
 
+    - path: "libs/cardano-ledger-api/testlib"
+      component: "cardano-ledger-api:lib:testlib"
+
     - path: "libs/cardano-ledger-api/test"
       component: "cardano-ledger-api:test:cardano-ledger-api-test"
 

libs/cardano-ledger-api/cardano-ledger-api.cabal

@@ -64,9 +64,7 @@ library
         text
 
 library testlib
-    exposed-modules:
-        Test.Cardano.Ledger.Api.State.Query
-
+    exposed-modules:  Test.Cardano.Ledger.Api.State.Query
     visibility:       public
     hs-source-dirs:   testlib
     default-language: Haskell2010
@@ -78,7 +76,7 @@ library testlib
     build-depends:
         base,
         containers,
-        cardano-ledger-core,
+        cardano-ledger-core
 
 test-suite cardano-ledger-api-test
     type:             exitcode-stdio-1.0
@@ -98,7 +96,8 @@ test-suite cardano-ledger-api-test
     build-depends:
         base,
         bytestring,
-        cardano-ledger-api:{cardano-ledger-api, testlib},
+        cardano-ledger-api,
+        testlib,
         cardano-ledger-binary,
         cardano-ledger-babbage:testlib,
         cardano-ledger-core:{cardano-ledger-core, testlib},

libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/QuerySpec.hs

@@ -1,4 +1,3 @@
-
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.Cardano.Ledger.Api.State.QuerySpec (spec) where

libs/cardano-ledger-api/test/Tests.hs

@@ -1,8 +1,8 @@
 module Main where
 
+import qualified Test.Cardano.Ledger.Api.State.QuerySpec as StateQuery (spec)
 import qualified Test.Cardano.Ledger.Api.Tx.Body as TxBody (spec)
 import qualified Test.Cardano.Ledger.Api.Tx.Out as TxOut (spec)
-import qualified Test.Cardano.Ledger.Api.State.QuerySpec as StateQuery (spec)
 import Test.Cardano.Ledger.Common
 
 -- ====================================================================================

libs/cardano-ledger-api/testlib/Test/Cardano/Ledger/Api/State/Query.hs

@@ -2,6 +2,7 @@
 
 module Test.Cardano.Ledger.Api.State.Query (
   -- * Old versions of queries
+
   --
   -- These are useful for testing and benchmarking
   getFilteredDelegationsAndRewardAccounts,

libs/cardano-ledger-core/cardano-ledger-core.cabal

@@ -152,7 +152,7 @@ library testlib
         nothunks,
         primitive,
         QuickCheck,
-        random >= 1.2,
+        random >=1.2,
         text,
         vector-map
 

libs/ledger-state/bench/Performance.hs

@@ -7,6 +7,7 @@
 module Main where
 
 import Cardano.Ledger.Address
+import Cardano.Ledger.Api.Era
 import Cardano.Ledger.Api.State.Query (queryStakePoolDelegsAndRewards)
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary
@@ -15,7 +16,7 @@ import Cardano.Ledger.Shelley.API.Mempool
 import Cardano.Ledger.Shelley.API.Wallet (getFilteredUTxO, getUTxO)
 import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis (..), fromNominalDiffTimeMicro, mkShelleyGlobals)
 import Cardano.Ledger.Shelley.LedgerState
-import Cardano.Ledger.State.UTxO
+import Cardano.Ledger.State.UTxO (CurrentEra, readNewEpochState)
 import Cardano.Ledger.UMap
 import Cardano.Ledger.UTxO
 import Cardano.Ledger.Val
@@ -29,8 +30,10 @@ import Data.ByteString.Base16.Lazy as BSL16
 import Data.ByteString.Lazy (ByteString)
 import Data.Default.Class (def)
 import Data.Foldable as F
+import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.MapExtras (extractKeys, extractKeysSmallSet)
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Lens.Micro ((^.))
 import System.Environment (getEnv)

libs/ledger-state/ledger-state.cabal

@@ -37,6 +37,7 @@ library
         bytestring,
         cardano-crypto-class,
         cardano-ledger-alonzo,
+        cardano-ledger-babbage,
         cardano-ledger-binary,
         cardano-ledger-core,
         cardano-ledger-mary,

libs/ledger-state/src/Cardano/Ledger/State/Orphans.hs

@@ -10,6 +10,7 @@ module Cardano.Ledger.State.Orphans where
 
 import Cardano.Crypto.Hash.Class
 import Cardano.Ledger.Alonzo.TxBody
+import Cardano.Ledger.Babbage.TxBody
 import Cardano.Ledger.BaseTypes (TxIx (..))
 import Cardano.Ledger.Binary
 import Cardano.Ledger.Coin
@@ -121,6 +122,10 @@ deriving via Enc (AlonzoTxOut CurrentEra) instance PersistField (AlonzoTxOut Cur
 
 deriving via Enc (AlonzoTxOut CurrentEra) instance PersistFieldSql (AlonzoTxOut CurrentEra)
 
+deriving via Enc (BabbageTxOut CurrentEra) instance PersistField (BabbageTxOut CurrentEra)
+
+deriving via Enc (BabbageTxOut CurrentEra) instance PersistFieldSql (BabbageTxOut CurrentEra)
+
 instance DecCBOR (DState CurrentEra) where
   decCBOR = decNoShareCBOR
 

libs/ledger-state/src/Cardano/Ledger/State/Query.hs

@@ -8,9 +8,9 @@
 
 module Cardano.Ledger.State.Query where
 
-import Cardano.Ledger.Alonzo.TxBody as Alonzo
+import Cardano.Ledger.Babbage.TxOut (internBabbageTxOut)
 import Cardano.Ledger.Binary
-import Cardano.Ledger.Core (emptyPParams)
+import Cardano.Ledger.Core (TxOut, emptyPParams)
 import qualified Cardano.Ledger.Credential as Credential
 import qualified Cardano.Ledger.EpochBoundary as EpochBoundary
 import qualified Cardano.Ledger.Keys as Keys
@@ -451,33 +451,22 @@ getSnapShotsWithSharing (Entity epochStateId EpochState {epochStateSnapShotsFee}
 
 sourceUTxO ::
   MonadResource m =>
-  ConduitM () (TxIn.TxIn C, AlonzoTxOut CurrentEra) (ReaderT SqlBackend m) ()
+  ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
 sourceUTxO =
   selectSource [] []
     .| mapC (\(Entity _ Tx {..}) -> (TxIn.TxIn txInId txInIx, txOut))
 
 sourceWithSharingUTxO ::
   MonadResource m =>
   Map.Map (Credential.StakeCredential C) a ->
-  ConduitM () (TxIn.TxIn C, AlonzoTxOut CurrentEra) (ReaderT SqlBackend m) ()
+  ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
 sourceWithSharingUTxO stakeCredentials =
-  sourceUTxO .| mapC (fmap internTxOut)
-  where
-    internTxOut = \case
-      Alonzo.TxOut_AddrHash28_AdaOnly cred addr28Extra e ->
-        Alonzo.TxOut_AddrHash28_AdaOnly (intern (Keys.coerceKeyRole cred) stakeCredentials) addr28Extra e
-      Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra e dataHash32 ->
-        Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32
-          (intern (Keys.coerceKeyRole cred) stakeCredentials)
-          addr28Extra
-          e
-          dataHash32
-      out -> out
+  sourceUTxO .| mapC (fmap (internBabbageTxOut (`intern` stakeCredentials)))
 
 foldDbUTxO ::
   MonadUnliftIO m =>
   -- | Folding function
-  (a -> (TxIn.TxIn C, AlonzoTxOut CurrentEra) -> a) ->
+  (a -> (TxIn.TxIn C, TxOut CurrentEra) -> a) ->
   -- | Empty acc
   a ->
   -- | Path to Sqlite db
@@ -487,7 +476,7 @@ foldDbUTxO f m fp = runSqlite fp (runConduit (sourceUTxO .| foldlC f m))
 
 -- sourceUTxOr ::
 --      MonadResource m
---   => Int64 -> Int64 -> ConduitM () (TxIn.TxIn C, AlonzoTxOut CurrentEra) (ReaderT SqlBackend m) ()
+--   => Int64 -> Int64 -> ConduitM () (TxIn.TxIn C, TxOut CurrentEra) (ReaderT SqlBackend m) ()
 -- sourceUTxOr b t =
 --   selectSource [TxId >. TxKey (SqlBackendKey b) , TxId <. TxKey (SqlBackendKey t)] [] .|
 --   mapC (\(Entity _ Tx {..}) -> (TxIn.TxIn txInId (fromIntegral txInIx), txOut))
@@ -496,7 +485,7 @@ foldDbUTxO f m fp = runSqlite fp (runConduit (sourceUTxO .| foldlC f m))
 --      MonadUnliftIO m
 --   => Int64
 --   -> Int64
---   -> (a -> (TxIn.TxIn C, AlonzoTxOut CurrentEra) -> a) -- ^ Folding function
+--   -> (a -> (TxIn.TxIn C, TxOut CurrentEra) -> a) -- ^ Folding function
 --   -> a -- ^ Empty acc
 --   -> T.Text -- ^ Path to Sqlite db
 --   -> m a
@@ -677,7 +666,7 @@ loadLedgerStateDStateTxIxSharing ::
   T.Text ->
   m
     ( Shelley.LedgerState CurrentEra
-    , IntMap.IntMap (Map.Map (TxIn.TxId C) (AlonzoTxOut CurrentEra))
+    , IntMap.IntMap (Map.Map (TxIn.TxId C) (TxOut CurrentEra))
     )
 loadLedgerStateDStateTxIxSharing fp =
   runSqlite fp $ do

libs/ledger-state/src/Cardano/Ledger/State/Schema.hs

@@ -13,7 +13,7 @@
 
 module Cardano.Ledger.State.Schema where
 
-import Cardano.Ledger.Alonzo.TxBody as Alonzo (AlonzoTxOut)
+import Cardano.Ledger.Babbage.TxOut (BabbageTxOut)
 import Cardano.Ledger.BaseTypes (TxIx (..))
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Core (PParams)
@@ -93,12 +93,12 @@ KeyHash
 Tx
   inIx TxIx
   inId (TxIn.TxId C)
-  out (AlonzoTxOut CurrentEra)
+  out (BabbageTxOut CurrentEra)
   UniqueTx inIx inId
 Txs
   inIx TxIx
   inId (TxIn.TxId C)
-  out (AlonzoTxOut CurrentEra)
+  out (BabbageTxOut CurrentEra)
   stakeCredential CredentialId Maybe
   UniqueTxs inIx inId
 UtxoEntry

libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs

@@ -7,16 +7,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans -funbox-strict-fields #-}
 
 module Cardano.Ledger.State.UTxO where
 
 import Cardano.Ledger.Address
-import Cardano.Ledger.Alonzo
 import Cardano.Ledger.Alonzo.Scripts.Data
 import Cardano.Ledger.Alonzo.TxBody
+import Cardano.Ledger.Babbage
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Core
@@ -47,7 +46,7 @@ import Text.Printf
 
 type C = StandardCrypto
 
-type CurrentEra = Alonzo
+type CurrentEra = Babbage
 
 --- Loading
 readNewEpochState ::
@@ -585,12 +584,14 @@ countTxOutStats :: [TxOut CurrentEra] -> TxOutStats
 countTxOutStats = foldMap countTxOutStat
   where
     countTxOutStat :: TxOut CurrentEra -> TxOutStats
-    countTxOutStat (AlonzoTxOut addr (MaryValue v (MultiAsset m)) mData) =
-      let !dataStat =
+    countTxOutStat txOut =
+      let addr = txOut ^. addrTxOutL
+          MaryValue v (MultiAsset m) = txOut ^. valueTxOutL
+          !dataStat =
             strictMaybe
               mempty
               (\d -> mempty {tosDataHash = statSingleton d})
-              mData
+              (txOut ^. dataHashTxOutL)
           !vmElems = Map.elems m
           !valueStat =
             dataStat
@@ -627,7 +628,7 @@ instance Pretty UTxOStats where
 instance AggregateStat UTxOStats where
   aggregateStat = aggregateStat . usTxOutStats
 
-countUTxOStats :: UTxO Alonzo -> UTxOStats
+countUTxOStats :: UTxO CurrentEra -> UTxOStats
 countUTxOStats (UTxO m) =
   UTxOStats
     { usTxInStats = countTxInStats (Map.keys m)