From a6ed1be1559e5c3ad5902e997c261e036439f541 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 27 Jun 2024 22:44:43 +0200 Subject: [PATCH] Make ProtocolState constructively --- cardano-api/cardano-api.cabal | 3 +++ .../Golden/Cardano/Api/EpochLeadership.hs | 25 ++++++++++++++++--- 2 files changed, 24 insertions(+), 4 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index be02ce47d6..cf10726eda 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -373,6 +373,7 @@ test-suite cardano-api-golden , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8 , cardano-ledger-shelley , cardano-ledger-shelley-test >= 1.2.0.1 + , cardano-protocol-tpraos , cardano-slotting ^>= 0.2.0.0 , containers , errors @@ -380,7 +381,9 @@ test-suite cardano-api-golden , hedgehog >= 1.1 , hedgehog-extras ^>= 0.6.1.0 , microlens + , ouroboros-consensus , ouroboros-consensus-cardano + , ouroboros-consensus-protocol , ouroboros-network-api , parsec , plutus-core ^>= 1.30 diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/EpochLeadership.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/EpochLeadership.hs index 827e88ea38..8e66ba4b90 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/EpochLeadership.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/EpochLeadership.hs @@ -1,4 +1,7 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} module Test.Golden.Cardano.Api.EpochLeadership ( test_golden_currentEpochEligibleLeadershipSlots @@ -9,18 +12,23 @@ import Cardano.Api.Block (EpochNo (..), Hash (StakePoolKeyHash), SlotN import Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..)) import Cardano.Api.Genesis (shelleyGenesisDefaults) import Cardano.Api.GenesisParameters (EpochSize (..)) -import Cardano.Api.Ledger (KeyHash (..), StandardCrypto) +import Cardano.Api.Ledger (KeyHash (..), StandardCrypto, toCBOR) import Cardano.Api.LedgerState (currentEpochEligibleLeadershipSlots) +import Cardano.Api.Modes (ConsensusProtocol) import Cardano.Api.Query (ProtocolState (..), SerialisedPoolDistribution (SerialisedPoolDistribution)) import Cardano.Api.Shelley (VrfKey, proxyToAsType, unStakePoolKeyHash) -import Cardano.Binary (serialize) +import Cardano.Binary (ToCBOR, serialize) import Cardano.Crypto.Seed (mkSeedFromBytes) import Cardano.Ledger.Api.PParams (emptyPParams) +import Cardano.Ledger.BaseTypes (Nonce (..), WithOrigin (..)) import Cardano.Ledger.Binary.Encoding (toByronCBOR) +import qualified Cardano.Protocol.TPraos.API as API import Cardano.Slotting.EpochInfo (EpochInfo (..)) import Cardano.Slotting.Time (RelativeTime (..), mkSlotLength) +import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus +import Ouroboros.Consensus.Protocol.TPraos (TPraosState (..)) import Ouroboros.Consensus.Shelley.Ledger.Query.Types (PoolDistr (..)) import Ouroboros.Network.Block (Serialised (..)) @@ -33,8 +41,16 @@ import qualified Hedgehog as H import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testProperty) +encodeProtocolState + :: ToCBOR (Consensus.ChainDepState (ConsensusProtocol era)) + => Consensus.ChainDepState (ConsensusProtocol era) + -> ProtocolState era +encodeProtocolState cds = ProtocolState (Serialised pbs) + where pbs = serialize (toCBOR cds) + test_golden_currentEpochEligibleLeadershipSlots :: TestTree -test_golden_currentEpochEligibleLeadershipSlots = testProperty "golden EpochLeadership" $ +test_golden_currentEpochEligibleLeadershipSlots = + testProperty "golden EpochLeadership" $ H.property $ do let sbe = ShelleyBasedEraShelley sGen = shelleyGenesisDefaults @@ -45,7 +61,8 @@ test_golden_currentEpochEligibleLeadershipSlots = testProperty "golden EpochLead , epochInfoSlotLength_ = const (pure $ mkSlotLength 10) } pp = emptyPParams - ptclState = ProtocolState (Serialised "dummyProtocolState") + chainDepState = TPraosState Origin (API.initialChainDepState NeutralNonce Map.empty) + ptclState = encodeProtocolState chainDepState poolid = StakePoolKeyHash { unStakePoolKeyHash = KeyHash "58eef2925db2789f76ea057c51069e52c5e0a44550f853c6cdf620f8" } vrskey = deterministicSigningKey (proxyToAsType (Proxy :: Proxy VrfKey)) (mkSeedFromBytes "") poolDistr :: PoolDistr StandardCrypto = PoolDistr Map.empty