Add Babbage tests

cardano-chain-gen/cardano-chain-gen.cabal

@@ -45,11 +45,12 @@ library
                         Cardano.Mock.ChainSync.Server
                         Cardano.Mock.ChainSync.State
                         Cardano.Mock.Forging.Crypto
-                        Cardano.Mock.Forging.Examples
                         Cardano.Mock.Forging.Interpreter
                         Cardano.Mock.Forging.Tx.Alonzo
+                        Cardano.Mock.Forging.Tx.Alonzo.Scenarios
                         Cardano.Mock.Forging.Tx.Alonzo.ScriptsExamples
                         Cardano.Mock.Forging.Tx.Babbage
+                        Cardano.Mock.Forging.Tx.Babbage.Scenarios
                         Cardano.Mock.Forging.Tx.Generic
                         Cardano.Mock.Forging.Tx.Shelley
                         Cardano.Mock.Forging.Types
@@ -154,7 +155,8 @@ test-suite cardano-chain-gen
 
   other-modules:        Test.Cardano.Db.Mock.Config
                         Test.Cardano.Db.Mock.Examples
-                        Test.Cardano.Db.Mock.Unit
+                        Test.Cardano.Db.Mock.Unit.Alonzo
+                        Test.Cardano.Db.Mock.Unit.Babbage
                         Test.Cardano.Db.Mock.UnifiedApi
                         Test.Cardano.Db.Mock.Validate
 

cardano-chain-gen/src/Cardano/Mock/Forging/Interpreter.hs

@@ -55,6 +55,7 @@ import qualified Cardano.Ledger.TxIn as Ledger
 
 import           Cardano.Mock.ChainDB
 import qualified Cardano.Mock.Forging.Tx.Alonzo as Alonzo
+import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage
 import qualified Cardano.Mock.Forging.Tx.Shelley as Shelley
 import           Cardano.Mock.Forging.Types
 
@@ -64,7 +65,7 @@ import           Ouroboros.Consensus.Block (BlockForging, BlockNo (..), BlockPro
                    ForgeStateInfo, ShouldForge (..), SlotNo (..), blockNo, blockSlot,
                    checkShouldForge)
 import qualified Ouroboros.Consensus.Block as Block
-import           Ouroboros.Consensus.Cardano.Block (AlonzoEra, BabbageEra, LedgerState (..), ShelleyEra)
+import           Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardAlonzo, StandardBabbage, StandardShelley)
 import           Ouroboros.Consensus.Cardano.CanHardFork ()
 import           Ouroboros.Consensus.Config (TopLevelConfig, configConsensus, configLedger,
                    topLevelConfigLedger)
@@ -246,6 +247,7 @@ forgeWithStakeCreds inter = do
   tx <- case ledgerState st of
           LedgerStateShelley sts -> either throwIO (pure . TxShelley) $ Shelley.mkDCertTxPools sts
           LedgerStateAlonzo sta -> either throwIO (pure . TxAlonzo) $ Alonzo.mkDCertTxPools sta
+          LedgerStateBabbage stb -> either throwIO (pure . TxBabbage) $ Babbage.mkDCertTxPools stb
           _ -> throwIO UnexpectedEra
   forgeNextFindLeader inter [tx]
 
@@ -383,7 +385,7 @@ getCurrentSlot :: Interpreter -> IO SlotNo
 getCurrentSlot interp = istSlot <$> readMVar (interpState interp)
 
 withBabbageLedgerState
-    :: Interpreter -> (LedgerState (ShelleyBlock PraosStandard (BabbageEra StandardCrypto)) -> Either ForgingError a)
+    :: Interpreter -> (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError a)
     -> IO a
 withBabbageLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -394,7 +396,7 @@ withBabbageLedgerState inter mk = do
     _ -> throwIO ExpectedBabbageState
 
 withAlonzoLedgerState
-    :: Interpreter -> (LedgerState (ShelleyBlock TPraosStandard (AlonzoEra StandardCrypto)) -> Either ForgingError a)
+    :: Interpreter -> (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError a)
     -> IO a
 withAlonzoLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -405,7 +407,7 @@ withAlonzoLedgerState inter mk = do
     _ -> throwIO ExpectedAlonzoState
 
 withShelleyLedgerState
-    :: Interpreter -> (LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) -> Either ForgingError a)
+    :: Interpreter -> (LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError a)
     -> IO a
 withShelleyLedgerState inter mk = do
   st <- getCurrentLedgerState inter
@@ -418,8 +420,9 @@ withShelleyLedgerState inter mk = do
 mkTxId :: TxEra -> Ledger.TxId StandardCrypto
 mkTxId txe =
   case txe of
-    TxAlonzo tx -> Ledger.txid @(AlonzoEra StandardCrypto) (getField @"body" tx)
-    TxShelley tx -> Ledger.txid @(ShelleyEra StandardCrypto) (getField @"body" tx)
+    TxAlonzo tx -> Ledger.txid @StandardAlonzo (getField @"body" tx)
+    TxBabbage tx -> Ledger.txid @StandardBabbage (getField @"body" tx)
+    TxShelley tx -> Ledger.txid @StandardShelley (getField @"body" tx)
 
 mkValidated :: TxEra -> Validated (Consensus.GenTx CardanoBlock)
 mkValidated txe =
@@ -430,13 +433,18 @@ mkValidated txe =
           (S (S (S (S (Z (Consensus.WrapValidatedGenTx
             (Consensus.mkShelleyValidatedTx $ Ledger.unsafeMakeValidated tx)
         )))))))
-
     TxShelley tx ->
       Consensus.HardForkValidatedGenTx
         (Consensus.OneEraValidatedGenTx
           (S (Z (Consensus.WrapValidatedGenTx
             (Consensus.mkShelleyValidatedTx $ Ledger.unsafeMakeValidated tx)
         ))))
+    TxBabbage tx ->
+      Consensus.HardForkValidatedGenTx
+        (Consensus.OneEraValidatedGenTx
+          (S (S (S (S (S (Z (Consensus.WrapValidatedGenTx
+            (Consensus.mkShelleyValidatedTx $ Ledger.unsafeMakeValidated tx)
+        ))))))))
 
 mkForecast
     :: TopLevelConfig CardanoBlock -> ExtLedgerState CardanoBlock

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Alonzo/Scenarios.hs

@@ -1,4 +1,4 @@
-module Cardano.Mock.Forging.Examples where
+module Cardano.Mock.Forging.Tx.Alonzo.Scenarios where
 
 import           Cardano.Prelude hiding (length, (.))
 

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs

@@ -44,7 +44,6 @@ import           Cardano.Ledger.ShelleyMA.Timelocks
 import           Cardano.Ledger.TxIn (TxIn (..), txid)
 
 import           Ouroboros.Consensus.Cardano.Block (LedgerState)
-import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import           Ouroboros.Consensus.Shelley.Eras (StandardBabbage, StandardCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage/Scenarios.hs

@@ -0,0 +1,42 @@
+module Cardano.Mock.Forging.Tx.Babbage.Scenarios where
+
+import           Cardano.Prelude hiding (length, (.))
+
+import           Data.List.Extra
+
+import           Cardano.Ledger.Mary.Value
+import           Cardano.Ledger.Shelley.API
+import           Cardano.Mock.Forging.Interpreter
+import qualified Cardano.Mock.Forging.Tx.Babbage as Babbage
+import           Cardano.Mock.Forging.Tx.Generic
+import           Cardano.Mock.Forging.Types
+
+delegateAndSendBlocks :: Int -> Interpreter -> IO [CardanoBlock]
+delegateAndSendBlocks n interpreter = do
+    addrFrom <- withBabbageLedgerState interpreter $ resolveAddress (UTxOIndex 0)
+    registerBlocks <- forM (chunksOf 500 creds) $ \blockCreds -> do
+      blockTxs <- withBabbageLedgerState interpreter $ \_st ->
+        forM (chunksOf 10 blockCreds) $ \txCreds -> -- 10 per tx
+          Babbage.mkDCertTx (fmap (DCertDeleg . RegKey) txCreds) (Wdrl mempty)
+      forgeNextFindLeader interpreter (TxBabbage <$> blockTxs)
+
+    delegateBlocks <- forM (chunksOf 500 creds) $ \blockCreds -> do
+      blockTxs <- withBabbageLedgerState interpreter $ \st ->
+        forM (chunksOf 10 blockCreds) $ \txCreds -> --do -- 10 per tx
+          Babbage.mkDCertTx
+            (fmap (\ (poolIx, cred) -> DCertDeleg $ Delegate $ Delegation cred (resolvePool (PoolIndex poolIx) st))
+                  (zip (cycle [0,1,2]) txCreds))
+            (Wdrl mempty)
+      forgeNextFindLeader interpreter (TxBabbage <$> blockTxs)
+
+    let utxoIndex = UTxOAddress addrFrom
+    sendBlocks <- forM (chunksOf 500 addresses) $ \blockAddresses -> do
+      blockTxs <- withBabbageLedgerState interpreter $ \st ->
+        forM (chunksOf 10 blockAddresses) $ \txAddresses ->
+          Babbage.mkPaymentTx' utxoIndex (fmap (\addr -> (UTxOAddress addr, Value 1 mempty)) txAddresses) st
+      forgeNextFindLeader interpreter (TxBabbage <$> blockTxs)
+    pure $ registerBlocks <> delegateBlocks <> sendBlocks
+  where
+    creds = createStakeCredentials n
+    pcreds = createPaymentCredentials n
+    addresses = fmap (\(pcred, cred) -> Addr Testnet pcred (StakeRefBase cred)) (zip pcreds creds)

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Shelley.hs

@@ -24,7 +24,6 @@ import           Cardano.Ledger.Shelley.Tx
 import           Cardano.Ledger.Shelley.TxBody
 
 import           Ouroboros.Consensus.Cardano.Block (LedgerState)
-import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import           Ouroboros.Consensus.Shelley.Eras (ShelleyEra, StandardCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 

cardano-chain-gen/src/Cardano/Mock/Forging/Types.hs

@@ -20,7 +20,8 @@ import qualified Ouroboros.Consensus.Cardano.Block as Consensus
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.Protocol.Praos (Praos)
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
-import           Ouroboros.Consensus.Shelley.Eras (AlonzoEra, ShelleyEra, StandardCrypto)
+import           Ouroboros.Consensus.Shelley.Eras (StandardAlonzo, StandardBabbage,
+                   StandardShelley, StandardCrypto)
 
 import           Cardano.Ledger.Address
 import qualified Cardano.Ledger.Core as Core
@@ -41,8 +42,9 @@ data MockBlock = MockBlock
   }
 
 data TxEra
-  = TxAlonzo !(Core.Tx (AlonzoEra StandardCrypto))
-  | TxShelley !(Core.Tx (ShelleyEra StandardCrypto))
+  = TxAlonzo !(Core.Tx StandardAlonzo)
+  | TxBabbage !(Core.Tx StandardBabbage)
+  | TxShelley !(Core.Tx StandardShelley)
 
 newtype NodeId = NodeId { unNodeId :: Int }
   deriving Show

cardano-chain-gen/test/Main.hs

@@ -15,7 +15,8 @@ import           Cardano.Mock.ChainSync.Server
 
 import           Test.Tasty
 
-import           Test.Cardano.Db.Mock.Unit
+import qualified Test.Cardano.Db.Mock.Unit.Alonzo as Alonzo
+import qualified Test.Cardano.Db.Mock.Unit.Babbage as Babbage
 
 main :: IO ()
 main = do
@@ -32,7 +33,9 @@ tests iom = do
     pure $
       testGroup
         "cardano-chain-gen"
-          [ unitTests iom knownMigrationsPlain
+          [
+            Babbage.unitTests iom knownMigrationsPlain
+          , Alonzo.unitTests iom knownMigrationsPlain
           ]
   where
     knownMigrationsPlain :: [(Text, Text)]

cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs

@@ -4,10 +4,13 @@ module Test.Cardano.Db.Mock.UnifiedApi
   , forgeNextSkipSlotsFindLeaderAndSubmit
   , forgeAndSubmitBlocks
   , withAlonzoFindLeaderAndSubmit
+  , withBabbageFindLeaderAndSubmit
   , withAlonzoFindLeaderAndSubmitTx
+  , withBabbageFindLeaderAndSubmitTx
   , withShelleyFindLeaderAndSubmit
   , withShelleyFindLeaderAndSubmitTx
   , getAlonzoLedgerState
+  , getBabbageLedgerState
   , skipUntilNextEpoch
   , fillUntilNextEpoch
   , fillEpochs
@@ -21,9 +24,8 @@ import           Cardano.Slotting.Slot (SlotNo (..))
 
 import qualified Cardano.Ledger.Core as Core
 
-import           Ouroboros.Consensus.Cardano.Block (AlonzoEra, ShelleyEra)
+import           Ouroboros.Consensus.Cardano.Block (StandardAlonzo, StandardBabbage, StandardShelley)
 import           Ouroboros.Consensus.Ledger.Basics (LedgerState)
-import           Ouroboros.Consensus.Protocol.TPraos
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 
 import           Cardano.Mock.ChainSync.Server
@@ -58,41 +60,61 @@ forgeAndSubmitBlocks interpreter mockServer blocksToCreate = do
 
 withAlonzoFindLeaderAndSubmit
     :: Interpreter -> ServerHandle IO CardanoBlock
-    -> (LedgerState (ShelleyBlock TPraosStandard (AlonzoEra StandardCrypto)) -> Either ForgingError [Core.Tx (AlonzoEra StandardCrypto)])
+    -> (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError [Core.Tx StandardAlonzo])
     -> IO CardanoBlock
 withAlonzoFindLeaderAndSubmit interpreter mockServer mkTxs = do
     alTxs <- withAlonzoLedgerState interpreter mkTxs
     forgeNextFindLeaderAndSubmit interpreter mockServer (TxAlonzo <$> alTxs)
 
+withBabbageFindLeaderAndSubmit
+    :: Interpreter -> ServerHandle IO CardanoBlock
+    -> (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError [Core.Tx StandardBabbage])
+    -> IO CardanoBlock
+withBabbageFindLeaderAndSubmit interpreter mockServer mkTxs = do
+    alTxs <- withBabbageLedgerState interpreter mkTxs
+    forgeNextFindLeaderAndSubmit interpreter mockServer (TxBabbage <$> alTxs)
+
 withAlonzoFindLeaderAndSubmitTx
     :: Interpreter -> ServerHandle IO CardanoBlock
-    -> (LedgerState (ShelleyBlock TPraosStandard (AlonzoEra StandardCrypto)) -> Either ForgingError (Core.Tx (AlonzoEra StandardCrypto)))
+    -> (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo) -> Either ForgingError (Core.Tx StandardAlonzo))
     -> IO CardanoBlock
 withAlonzoFindLeaderAndSubmitTx interpreter mockServer mkTxs = do
     withAlonzoFindLeaderAndSubmit interpreter mockServer $ \st -> do
         tx <- mkTxs st
         pure [tx]
 
+withBabbageFindLeaderAndSubmitTx
+    :: Interpreter -> ServerHandle IO CardanoBlock
+    -> (LedgerState (ShelleyBlock PraosStandard StandardBabbage) -> Either ForgingError (Core.Tx StandardBabbage))
+    -> IO CardanoBlock
+withBabbageFindLeaderAndSubmitTx interpreter mockServer mkTxs = do
+    withBabbageFindLeaderAndSubmit interpreter mockServer $ \st -> do
+        tx <- mkTxs st
+        pure [tx]
+
 withShelleyFindLeaderAndSubmit
     :: Interpreter -> ServerHandle IO CardanoBlock
-    -> (LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) -> Either ForgingError [Core.Tx (ShelleyEra StandardCrypto)])
+    -> (LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError [Core.Tx StandardShelley])
     -> IO CardanoBlock
 withShelleyFindLeaderAndSubmit interpreter mockServer mkTxs = do
     alTxs <- withShelleyLedgerState interpreter mkTxs
     forgeNextFindLeaderAndSubmit interpreter mockServer (TxShelley <$> alTxs)
 
 withShelleyFindLeaderAndSubmitTx
     :: Interpreter -> ServerHandle IO CardanoBlock
-    -> (LedgerState (ShelleyBlock TPraosStandard (ShelleyEra StandardCrypto)) -> Either ForgingError (Core.Tx (ShelleyEra StandardCrypto)))
+    -> (LedgerState (ShelleyBlock TPraosStandard StandardShelley) -> Either ForgingError (Core.Tx StandardShelley))
     -> IO CardanoBlock
 withShelleyFindLeaderAndSubmitTx interpreter mockServer mkTxs = do
     withShelleyFindLeaderAndSubmit interpreter mockServer $ \st -> do
         tx <- mkTxs st
         pure [tx]
 
-getAlonzoLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard (AlonzoEra StandardCrypto)))
+getAlonzoLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock TPraosStandard StandardAlonzo))
 getAlonzoLedgerState interpreter = withAlonzoLedgerState interpreter Right
 
+getBabbageLedgerState :: Interpreter -> IO (LedgerState (ShelleyBlock PraosStandard StandardBabbage))
+getBabbageLedgerState interpreter = withBabbageLedgerState interpreter Right
+
 skipUntilNextEpoch :: Interpreter -> ServerHandle IO CardanoBlock -> [TxEra] -> IO CardanoBlock
 skipUntilNextEpoch interpreter mockServer txsEra = do
     slot <- getCurrentSlot interpreter