{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Only Dijkstra allows an endorser block to hold anything, and it reads the
-- endorser-block capacity from its protocol parameters.
module Test.Consensus.Cardano.Capacity (tests) where

import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Dijkstra.PParams
  ( ppMaxEndorserBlockExUnitsL
  , ppMaxEndorserBlockReferencesSizeL
  , ppMaxEndorserBlockTxsSizeL
  , ppMaxRefScriptSizePerEndorserBlockL
  )
import qualified Cardano.Ledger.Genesis as Genesis
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..), OrdExUnits (..))
import Cardano.Ledger.Shelley.API (ShelleyGenesis (..))
import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
import Cardano.Ledger.Shelley.Translation
  ( emptyFromByronTranslationContext
  )
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import qualified Data.Measure as Measure
import Data.Proxy (Proxy (..))
import Lens.Micro ((&), (.~))
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
  ( slotLengthFromSec
  )
import Ouroboros.Consensus.Byron.Ledger
  ( ByronBlock
  , byronLedgerState
  , byronLedgerTransition
  )
import Ouroboros.Consensus.Byron.Ledger.Ledger
  ( Ticked (TickedByronLedgerState)
  )
import Ouroboros.Consensus.Ledger.Basics
  ( LedgerConfig
  , LedgerState
  , TickedLedgerState
  )
import Ouroboros.Consensus.Ledger.SupportsMempool
  ( ByteSize32 (..)
  , IgnoringOverflow (..)
  , TxLimits (..)
  , TxMeasure (..)
  )
import Ouroboros.Consensus.Ledger.Tables
import Ouroboros.Consensus.Protocol.Praos (Praos)
import Ouroboros.Consensus.Protocol.Praos2 (Praos2)
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Eras
import Ouroboros.Consensus.Shelley.HFEras ()
import Ouroboros.Consensus.Shelley.Ledger
  ( ShelleyBlock
  , ShelleyLedgerConfig
  , mkShelleyLedgerConfig
  )
import Ouroboros.Consensus.Shelley.Ledger.Ledger
  ( LedgerState (ShelleyLedgerState)
  , Ticked (TickedShelleyLedgerState)
  )
import Ouroboros.Consensus.Shelley.Ledger.Mempool
  ( AlonzoMeasure (..)
  , DijkstraEbMeasure (..)
  , RefScriptSize (..)
  , fromExUnits
  )
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Examples (testShelleyGenesis)
import Test.Consensus.Byron.Generators
  ( genByronLedgerConfig
  , genByronLedgerState
  )
import Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron)
import Test.Consensus.Shelley.Generators ()
import Test.Tasty
import Test.Tasty.HUnit (Assertion, testCase, (@?=))
import Test.Tasty.QuickCheck

type Crypto = MockCryptoCompatByron

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Endorser-block capacity"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Byron" Property
prop_byron
    , TestName
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Shelley" ((LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (TPraos Crypto) ShelleyEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(TPraos Crypto) @ShelleyEra
          (FromByronTranslationContext -> Gen FromByronTranslationContext
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FromByronTranslationContext
emptyFromByronTranslationContext)
    , TestName
-> (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Allegra" ((LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AllegraEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(TPraos Crypto) @AllegraEra (NoGenesis AllegraEra -> Gen (NoGenesis AllegraEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoGenesis AllegraEra
forall era. NoGenesis era
Genesis.NoGenesis)
    , TestName
-> (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Mary" ((LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (TPraos Crypto) MaryEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(TPraos Crypto) @MaryEra (NoGenesis MaryEra -> Gen (NoGenesis MaryEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoGenesis MaryEra
forall era. NoGenesis era
Genesis.NoGenesis)
    , TestName
-> (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Alonzo" ((LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (TPraos Crypto) AlonzoEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(TPraos Crypto) @AlonzoEra Gen (TranslationContext AlonzoEra)
Gen AlonzoGenesis
forall a. Arbitrary a => Gen a
arbitrary
    , TestName
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Babbage" ((LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (Praos Crypto) BabbageEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(Praos Crypto) @BabbageEra (NoGenesis BabbageEra -> Gen (NoGenesis BabbageEra)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoGenesis BabbageEra
forall era. NoGenesis era
Genesis.NoGenesis)
    , TestName
-> (LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Conway" ((LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
  -> Property)
 -> TestTree)
-> (LedgerState (ShelleyBlock (Praos Crypto) ConwayEra) EmptyMK
    -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$
        forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased @(Praos Crypto) @ConwayEra Gen (TranslationContext ConwayEra)
Gen ConwayGenesis
forall a. Arbitrary a => Gen a
arbitrary
    , TestName
-> (LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Dijkstra" LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
-> Property
prop_dijkstra
    , TestName -> Assertion -> TestTree
testCase TestName
"Dijkstra transaction" Assertion
test_dijkstraTxEbMeasure
    ]

-- | Both endorser-block measures are zero.
prop_capacityHasNoEndorserBlock ::
  forall blk mk.
  TxLimits blk =>
  LedgerConfig blk ->
  TickedLedgerState blk mk ->
  Property
prop_capacityHasNoEndorserBlock :: forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> Property
prop_capacityHasNoEndorserBlock LedgerConfig blk
cfg TickedLedgerState blk mk
st =
  [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
    [ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"endorser-block capacity" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
forall (mk :: MapKind).
LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
ebCapacityTxMeasure LedgerConfig blk
cfg TickedLedgerState blk mk
st TxEbMeasure blk -> TxEbMeasure blk -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxEbMeasure blk
forall a. Measure a => a
Measure.zero
    , TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"mempool reservation for an endorser block" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Proxy blk -> TxEbMeasure blk -> TxMeasure blk
forall blk (proxy :: * -> *).
TxLimits blk =>
proxy blk -> TxEbMeasure blk -> TxMeasure blk
forall (proxy :: * -> *).
proxy blk -> TxEbMeasure blk -> TxMeasure blk
mempoolEbReservation (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) (LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
forall (mk :: MapKind).
LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
ebCapacityTxMeasure LedgerConfig blk
cfg TickedLedgerState blk mk
st) TxMeasure blk -> TxMeasure blk -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxMeasure blk
forall a. Measure a => a
Measure.zero
    ]

prop_byron :: Property
prop_byron :: Property
prop_byron =
  Gen Config -> (Config -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Config
genByronLedgerConfig ((Config -> Property) -> Property)
-> (Config -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Config
cfg ->
    Gen (LedgerState ByronBlock EmptyMK)
-> (LedgerState ByronBlock EmptyMK -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (LedgerState ByronBlock EmptyMK)
genByronLedgerState ((LedgerState ByronBlock EmptyMK -> Property) -> Property)
-> (LedgerState ByronBlock EmptyMK -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \LedgerState ByronBlock EmptyMK
st ->
      forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> Property
prop_capacityHasNoEndorserBlock @ByronBlock Config
LedgerConfig ByronBlock
cfg (LedgerState ByronBlock EmptyMK
-> TickedLedgerState ByronBlock EmptyMK
forall (mk :: MapKind).
LedgerState ByronBlock mk -> TickedLedgerState ByronBlock mk
tickByron LedgerState ByronBlock EmptyMK
st)

prop_shelleyBased ::
  forall proto era.
  TxLimits (ShelleyBlock proto era) =>
  Gen (Core.TranslationContext era) ->
  LedgerState (ShelleyBlock proto era) EmptyMK ->
  Property
prop_shelleyBased :: forall proto era.
TxLimits (ShelleyBlock proto era) =>
Gen (TranslationContext era)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Property
prop_shelleyBased Gen (TranslationContext era)
genTranslationContext LedgerState (ShelleyBlock proto era) EmptyMK
st =
  Gen (TranslationContext era)
-> (TranslationContext era -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (TranslationContext era)
genTranslationContext ((TranslationContext era -> Property) -> Property)
-> (TranslationContext era -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \TranslationContext era
translationContext ->
    forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> Property
prop_capacityHasNoEndorserBlock @(ShelleyBlock proto era)
      (TranslationContext era -> ShelleyLedgerConfig era
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext era
translationContext)
      (LedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
tickShelley LedgerState (ShelleyBlock proto era) EmptyMK
st)

-- | Each of the four endorser-block parameters lands in its own field of the
-- endorser-block capacity. The values differ, so a swapped lens fails. The
-- references capacity is the parameter minus the 5 bytes of the widest CBOR map
-- header.
--
-- Few runs: setting the parameters forces the whole arbitrary ledger state,
-- which is slow to generate, and the result depends only on the parameters.
prop_dijkstra ::
  LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK ->
  Property
prop_dijkstra :: LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
-> Property
prop_dijkstra LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
st =
  Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withNumTests Int
10 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    Gen DijkstraGenesis -> (DijkstraGenesis -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen DijkstraGenesis
forall a. Arbitrary a => Gen a
arbitrary ((DijkstraGenesis -> Property) -> Property)
-> (DijkstraGenesis -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \DijkstraGenesis
translationContext ->
      let capacity :: TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
capacity =
            LedgerConfig (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TickedLedgerState
     (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> TxEbMeasure blk
forall (mk :: MapKind).
LedgerConfig (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TickedLedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) mk
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
ebCapacityTxMeasure
              (TranslationContext DijkstraEra -> ShelleyLedgerConfig DijkstraEra
forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext DijkstraEra
DijkstraGenesis
translationContext)
              (TickedLedgerState
  (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
-> TickedLedgerState
     (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
forall {era} {proto} {mk :: MapKind}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraGov era, DijkstraEraPParams era) =>
Ticked LedgerState (ShelleyBlock proto era) mk
-> Ticked LedgerState (ShelleyBlock proto era) mk
withEndorserBlockParams (LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
-> TickedLedgerState
     (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
tickShelley LedgerState (ShelleyBlock (Praos2 Crypto) DijkstraEra) EmptyMK
st))
       in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
            [ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"endorser-block capacity" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
DijkstraEbMeasure
capacity
                  DijkstraEbMeasure -> DijkstraEbMeasure -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== DijkstraEbMeasure
                    { ebClosureMeasure :: TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure = TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasurePhase2
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
AlonzoMeasure
closureAlonzo TxMeasurePhase2 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
RefScriptSize
closureRefScripts
                    , txReferencesSize :: IgnoringOverflow ByteSize32
txReferencesSize = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
5000)
                    }
            , TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"mempool reservation for an endorser block" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                Proxy (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
forall blk (proxy :: * -> *).
TxLimits blk =>
proxy blk -> TxEbMeasure blk -> TxMeasure blk
forall (proxy :: * -> *).
proxy (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
mempoolEbReservation (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock (Praos2 Crypto) DijkstraEra)) TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
capacity
                  TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxMeasurePhase1 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasurePhase2 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
AlonzoMeasure
closureAlonzo TxMeasurePhase2 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
RefScriptSize
closureRefScripts
            ]
 where
  closureAlonzo :: AlonzoMeasure
closureAlonzo =
    AlonzoMeasure
      { byteSize :: IgnoringOverflow ByteSize32
byteSize = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
1001)
      , exUnits :: ExUnits' Nat
exUnits = ExUnits -> ExUnits' Nat
fromExUnits (Nat -> Nat -> ExUnits
ExUnits Nat
2002 Nat
3003)
      }
  closureRefScripts :: RefScriptSize
closureRefScripts = IgnoringOverflow ByteSize32 -> RefScriptSize
RefScriptSize (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
4004))

  withEndorserBlockParams :: Ticked LedgerState (ShelleyBlock proto era) mk
-> Ticked LedgerState (ShelleyBlock proto era) mk
withEndorserBlockParams (TickedShelleyLedgerState WithOrigin (ShelleyTip proto era)
tip ShelleyTransition
transition NewEpochState era
nes LedgerTables (ShelleyBlock proto era) mk
ledgerTables) =
    WithOrigin (ShelleyTip proto era)
-> ShelleyTransition
-> NewEpochState era
-> LedgerTables (ShelleyBlock proto era) mk
-> Ticked LedgerState (ShelleyBlock proto era) mk
forall proto era (mk :: MapKind).
WithOrigin (ShelleyTip proto era)
-> ShelleyTransition
-> NewEpochState era
-> LedgerTables (ShelleyBlock proto era) mk
-> Ticked LedgerState (ShelleyBlock proto era) mk
TickedShelleyLedgerState
      WithOrigin (ShelleyTip proto era)
tip
      ShelleyTransition
transition
      ( NewEpochState era
nes
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((Word32 -> Identity Word32)
    -> EpochState era -> Identity (EpochState era))
-> (Word32 -> Identity Word32)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> ((Word32 -> Identity Word32)
    -> PParams era -> Identity (PParams era))
-> (Word32 -> Identity Word32)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxEndorserBlockTxsSizeL ((Word32 -> Identity Word32)
 -> NewEpochState era -> Identity (NewEpochState era))
-> Word32 -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
1001
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((OrdExUnits -> Identity OrdExUnits)
    -> EpochState era -> Identity (EpochState era))
-> (OrdExUnits -> Identity OrdExUnits)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> ((OrdExUnits -> Identity OrdExUnits)
    -> PParams era -> Identity (PParams era))
-> (OrdExUnits -> Identity OrdExUnits)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrdExUnits -> Identity OrdExUnits)
-> PParams era -> Identity (PParams era)
forall era.
DijkstraEraPParams era =>
Lens' (PParams era) OrdExUnits
Lens' (PParams era) OrdExUnits
ppMaxEndorserBlockExUnitsL
            ((OrdExUnits -> Identity OrdExUnits)
 -> NewEpochState era -> Identity (NewEpochState era))
-> OrdExUnits -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ExUnits -> OrdExUnits
OrdExUnits (Nat -> Nat -> ExUnits
ExUnits Nat
2002 Nat
3003)
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((Word32 -> Identity Word32)
    -> EpochState era -> Identity (EpochState era))
-> (Word32 -> Identity Word32)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> ((Word32 -> Identity Word32)
    -> PParams era -> Identity (PParams era))
-> (Word32 -> Identity Word32)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxRefScriptSizePerEndorserBlockL ((Word32 -> Identity Word32)
 -> NewEpochState era -> Identity (NewEpochState era))
-> Word32 -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
4004
          NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((Word32 -> Identity Word32)
    -> EpochState era -> Identity (EpochState era))
-> (Word32 -> Identity Word32)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> ((Word32 -> Identity Word32)
    -> PParams era -> Identity (PParams era))
-> (Word32 -> Identity Word32)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxEndorserBlockReferencesSizeL ((Word32 -> Identity Word32)
 -> NewEpochState era -> Identity (NewEpochState era))
-> Word32 -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
5005
      )
      LedgerTables (ShelleyBlock proto era) mk
ledgerTables

-- | A Dijkstra transaction costs its block measure in the closure, and the
-- reference 'Ouroboros.Consensus.Leios.Types.encodeLeiosEb' writes for its
-- byte size. The reference-scripts size differs from the byte size, so
-- reading the wrong field fails.
test_dijkstraTxEbMeasure :: Assertion
test_dijkstraTxEbMeasure :: Assertion
test_dijkstraTxEbMeasure =
  Proxy (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
forall blk (proxy :: * -> *).
TxLimits blk =>
proxy blk -> TxMeasure blk -> TxEbMeasure blk
forall (proxy :: * -> *).
proxy (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxEbMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
txEbMeasure
    (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ShelleyBlock (Praos2 Crypto) DijkstraEra))
    (TxMeasurePhase1 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasurePhase2 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 Crypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
AlonzoMeasure
alonzo TxMeasurePhase2 (ShelleyBlock (Praos2 Crypto) DijkstraEra)
RefScriptSize
refScripts)
    DijkstraEbMeasure -> DijkstraEbMeasure -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= DijkstraEbMeasure
      { ebClosureMeasure :: TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure = TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasurePhase2
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
AlonzoMeasure
alonzo TxMeasurePhase2 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
RefScriptSize
refScripts
      , -- 34 bytes for the hash, 3 bytes for a size of 300
        txReferencesSize :: IgnoringOverflow ByteSize32
txReferencesSize = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
37)
      }
 where
  alonzo :: AlonzoMeasure
alonzo =
    AlonzoMeasure
      { byteSize :: IgnoringOverflow ByteSize32
byteSize = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
300)
      , exUnits :: ExUnits' Nat
exUnits = ExUnits -> ExUnits' Nat
fromExUnits (Nat -> Nat -> ExUnits
ExUnits Nat
1 Nat
2)
      }
  refScripts :: RefScriptSize
refScripts = IgnoringOverflow ByteSize32 -> RefScriptSize
RefScriptSize (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (Word32 -> ByteSize32
ByteSize32 Word32
10))

{-------------------------------------------------------------------------------
  Fixtures
-------------------------------------------------------------------------------}

fixedShelleyLedgerConfig ::
  Core.TranslationContext era ->
  ShelleyLedgerConfig era
fixedShelleyLedgerConfig :: forall era. TranslationContext era -> ShelleyLedgerConfig era
fixedShelleyLedgerConfig TranslationContext era
translationContext =
  ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
forall era.
ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig
    ShelleyGenesis
testShelleyGenesis
    TranslationContext era
translationContext
    (EpochSize -> SlotLength -> EpochInfo (Except PastHorizonException)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (ShelleyGenesis -> EpochSize
sgEpochLength ShelleyGenesis
testShelleyGenesis) (Integer -> SlotLength
slotLengthFromSec Integer
2))

tickByron :: LedgerState ByronBlock mk -> TickedLedgerState ByronBlock mk
tickByron :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> TickedLedgerState ByronBlock mk
tickByron LedgerState ByronBlock mk
st =
  ChainValidationState
-> ByronTransition -> Ticked LedgerState ByronBlock mk
forall (mk :: MapKind).
ChainValidationState
-> ByronTransition -> Ticked LedgerState ByronBlock mk
TickedByronLedgerState
    (LedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState LedgerState ByronBlock mk
st)
    (LedgerState ByronBlock mk -> ByronTransition
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ByronTransition
byronLedgerTransition LedgerState ByronBlock mk
st)

tickShelley ::
  LedgerState (ShelleyBlock proto era) EmptyMK ->
  TickedLedgerState (ShelleyBlock proto era) EmptyMK
tickShelley :: forall proto era.
LedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
tickShelley (ShelleyLedgerState WithOrigin (ShelleyTip proto era)
tip NewEpochState era
state ShelleyTransition
transition LedgerTables (ShelleyBlock proto era) EmptyMK
ledgerTables) =
  WithOrigin (ShelleyTip proto era)
-> ShelleyTransition
-> NewEpochState era
-> LedgerTables (ShelleyBlock proto era) EmptyMK
-> Ticked LedgerState (ShelleyBlock proto era) EmptyMK
forall proto era (mk :: MapKind).
WithOrigin (ShelleyTip proto era)
-> ShelleyTransition
-> NewEpochState era
-> LedgerTables (ShelleyBlock proto era) mk
-> Ticked LedgerState (ShelleyBlock proto era) mk
TickedShelleyLedgerState WithOrigin (ShelleyTip proto era)
tip ShelleyTransition
transition NewEpochState era
state LedgerTables (ShelleyBlock proto era) EmptyMK
ledgerTables