Skip to content

Commit

Permalink
wip - bbody imp test
Browse files Browse the repository at this point in the history
  • Loading branch information
teodanciu committed Jul 1, 2024
1 parent dfdda6a commit dd4897a
Show file tree
Hide file tree
Showing 9 changed files with 99 additions and 2 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/Imp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ spec ::
( Arbitrary (TxAuxData era)
, MaryEraImp era
, AllegraEraScript era
, EraSegWits era
, InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
) =>
Expand Down
1 change: 1 addition & 0 deletions eras/shelley/impl/cardano-ledger-shelley.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 4 additions & 1 deletion eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -19,15 +20,17 @@ 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
) =>
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
Expand Down
Original file line number Diff line number Diff line change
@@ -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
16 changes: 15 additions & 1 deletion eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,7 @@ module Test.Cardano.Ledger.Shelley.ImpTest (
ScriptTestContext,
initShelleyImpNES,
impWitsVKeyNeeded,
impLedgerEnv,
modifyPrevPParams,
passEpoch,
passNEpochs,
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit dd4897a

Please sign in to comment.