diff --git a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs index 64e7106f0e0..b109193e2d7 100644 --- a/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs +++ b/eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Imp.hs @@ -17,6 +17,7 @@ import Test.Cardano.Ledger.Shelley.ImpTest spec :: forall era. ( Arbitrary (TxAuxData era) + , EraSegWits era , ShelleyEraImp era , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs index 12191249e9a..94bc7d5f2e9 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs @@ -24,6 +24,7 @@ spec :: forall era. ( Arbitrary (TxAuxData era) , AlonzoEraImp era + , EraSegWits era , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era diff --git a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs index 4b9ea46e903..c7eb5ea8c75 100644 --- a/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs +++ b/eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Imp.hs @@ -28,6 +28,7 @@ spec :: ( Arbitrary (TxAuxData era) , AlonzoEraImp era , BabbageEraTxOut era + , EraSegWits era , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index f63616003c8..19ec11e8c26 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -47,6 +47,7 @@ spec :: forall era. ( Arbitrary (TxAuxData era) , ConwayEraImp era + , EraSegWits era , GovState era ~ ConwayGovState era , PParamsHKD Identity era ~ ConwayPParams Identity era , InjectRuleFailure "LEDGER" ConwayGovPredFailure era diff --git a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs index 8d7156bbf08..718b42a0124 100644 --- a/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs +++ b/eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs @@ -21,6 +21,7 @@ spec :: ( Arbitrary (TxAuxData era) , MaryEraImp era , AllegraEraScript era + , EraSegWits era , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era ) => diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index c70b24e0098..da1831d746f 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -140,6 +140,7 @@ library testlib Test.Cardano.Ledger.Shelley.Constants Test.Cardano.Ledger.Shelley.ImpTest Test.Cardano.Ledger.Shelley.Imp + Test.Cardano.Ledger.Shelley.Imp.BbodySpec Test.Cardano.Ledger.Shelley.Imp.EpochSpec Test.Cardano.Ledger.Shelley.Imp.LedgerSpec Test.Cardano.Ledger.Shelley.Imp.UtxoSpec diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs index a651a78a926..c854d08e37b 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs @@ -9,6 +9,7 @@ module Test.Cardano.Ledger.Shelley.Imp (spec) where import Cardano.Ledger.Core import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, ShelleyUtxowPredFailure) import Test.Cardano.Ledger.Common +import qualified Test.Cardano.Ledger.Shelley.Imp.BbodySpec as Bbody import qualified Test.Cardano.Ledger.Shelley.Imp.EpochSpec as Epoch import qualified Test.Cardano.Ledger.Shelley.Imp.LedgerSpec as Ledger import qualified Test.Cardano.Ledger.Shelley.Imp.UtxoSpec as Utxo @@ -19,6 +20,7 @@ import qualified Test.Cardano.Ledger.Shelley.UnitTests.IncrementalStakeTest as I spec :: forall era. ( Arbitrary (TxAuxData era) + , EraSegWits era , ShelleyEraImp era , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era @@ -26,8 +28,9 @@ spec :: Spec spec = do describe "ShelleyImpSpec" $ withImpState @era $ do - Ledger.spec @era + Bbody.spec @era Epoch.spec @era + Ledger.spec @era Utxow.spec @era Utxo.spec @era describe "ShelleyPureTests" $ do diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/BbodySpec.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/BbodySpec.hs new file mode 100644 index 00000000000..2d8550caa6b --- /dev/null +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/BbodySpec.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cardano.Ledger.Shelley.Imp.BbodySpec ( + spec, +) where + +import Cardano.Ledger.BHeaderView (BHeaderView (..)) +import Cardano.Ledger.BaseTypes (BlocksMade (..), ProtVer (..), ShelleyBase, SlotNo (..), inject) +import Cardano.Ledger.Block +import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Shelley.Core +import Cardano.Ledger.Shelley.LedgerState +import Cardano.Ledger.Shelley.Rules ( + BbodyEnv (..), + Event, + LedgerEnv (..), + ShelleyBbodyState (..), + ) +import Cardano.Ledger.Shelley.UTxO (UTxO (..)) +import Control.Monad.State.Strict (MonadState (..), gets) +import Control.State.Transition.Extended (STS (..)) +import Data.Bifunctor (first) +import qualified Data.Map as Map +import qualified Data.Map.Strict as Map +import qualified Data.Sequence.Strict as SSeq +import qualified Data.Set as Set +import Debug.Trace +import Lens.Micro ((&), (.~), (^.)) +import Lens.Micro.Mtl +import Test.Cardano.Ledger.Core.KeyPair (mkAddr) +import Test.Cardano.Ledger.Core.Utils (txInAt) +import Test.Cardano.Ledger.Imp.Common +import Test.Cardano.Ledger.Shelley.ImpTest + +spec :: + forall era. + ( ShelleyEraImp era + , EraSegWits era + ) => + SpecWith (ImpTestState era) +spec = describe "BBODY" $ do + it "Works" $ do + let !_ = trace ("\n Works??" <> (show True) <> "\n") True + nes <- use impNESL + LedgerEnv {ledgerPp, ledgerAccount} <- impLedgerEnv nes + let env = BbodyEnv ledgerPp ledgerAccount + let ls = nes ^. nesEsL . esLStateL + let state = BbodyState ls (BlocksMade Map.empty) + kh <- freshKeyHash + tx <- fixupTx $ mkBasicTx mkBasicTxBody + let txSeq = toTxSeq @era $ SSeq.fromList [tx] + let bhView = + BHeaderView + { bhviewID = kh + , bhviewBSize = fromIntegral $ bBodySize (ProtVer (eraProtVerLow @era) 0) txSeq + , bhviewHSize = 0 + , bhviewBHash = hashTxSeq txSeq + , bhviewSlot = SlotNo 0 + } + let signal = UnsafeUnserialisedBlock bhView txSeq + res <- + tryRunImpRule @"BBODY" + env + state + (UnsafeUnserialisedBlock bhView txSeq) + expectRight res + pure () + +-- expectRightDeepExpr $ first fst res diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs index 331954a460e..465659413b2 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs @@ -40,6 +40,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest ( ScriptTestContext, initShelleyImpNES, impWitsVKeyNeeded, + impLedgerEnv, modifyPrevPParams, passEpoch, passNEpochs, @@ -125,8 +126,10 @@ import Cardano.Ledger.Address ( RewardAccount (..), bootstrapKeyHash, ) +import Cardano.Ledger.BHeaderView (BHeaderView) import Cardano.Ledger.BaseTypes import Cardano.Ledger.Binary (DecCBOR, EncCBOR) +import Cardano.Ledger.Block (Block) import Cardano.Ledger.CertState (certDStateL, dsUnifiedL) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core @@ -173,7 +176,11 @@ import Cardano.Ledger.Shelley.LedgerState ( utxosDonationL, utxosUtxoL, ) -import Cardano.Ledger.Shelley.Rules (LedgerEnv (..)) +import Cardano.Ledger.Shelley.Rules ( + BbodyEnv (..), + LedgerEnv (..), + ShelleyBbodyState, + ) import Cardano.Ledger.Shelley.Scripts ( ShelleyEraScript, pattern RequireAllOf, @@ -348,6 +355,13 @@ class , ToExpr (StashedAVVMAddresses era) , NFData (StashedAVVMAddresses era) , Default (StashedAVVMAddresses era) + , -- For BBODY rule + STS (EraRule "BBODY" era) + , BaseM (EraRule "BBODY" era) ~ ShelleyBase + , Environment (EraRule "BBODY" era) ~ BbodyEnv era + , State (EraRule "BBODY" era) ~ ShelleyBbodyState era + , Signal (EraRule "BBODY" era) ~ Block (BHeaderView (EraCrypto era)) era + , State (EraRule "LEDGERS" era) ~ LedgerState era , -- For the LEDGER rule STS (EraRule "LEDGER" era) , BaseM (EraRule "LEDGER" era) ~ ShelleyBase