Pass `Constants` as a parameter to `forAllChainTrace`
for more flexibility in Generators
for more flexibility in Generators
import Test.Cardano.Ledger.Alonzo.EraMapping ()
import Test.Cardano.Ledger.Alonzo.Trace ()
import Test.Cardano.Ledger.EraBuffet (TestCrypto)
import Test.Cardano.Ledger.Shelley.Generator.Constants (
defaultConstants,
)
import qualified Test.Cardano.Ledger.Shelley.PropertyTests as Shelley
import Test.Cardano.Ledger.Shelley.Rules.Chain (
CHAIN,
alonzoTraceTests :: Property
alonzoTraceTests =
forAllChainTrace @A traceLen $ \tr ->
forAllChainTrace @A traceLen defaultConstants $ \tr ->
conjoin $ map alonzoSpecificProps (sourceSignalTargets tr)
propertyTests :: TestTree
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), vKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C)
import Test.Cardano.Ledger.Shelley.Generator.Constants (defaultConstants)
import Test.Cardano.Ledger.Shelley.Generator.Core (genCoin, genNatural)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainEvent (..), ChainState (..))
-- | Provide a legitimate NewEpochState to make an test Property
newEpochProp :: Word64 -> (NewEpochState C -> Property) -> Property
newEpochProp tracelen propf = withMaxSuccess 100 $
forAllChainTrace @C tracelen $ \tr ->
forAllChainTrace @C tracelen defaultConstants $ \tr ->
case lastElem (sourceSignalTargets tr) of
Just SourceSignalTarget {target} -> propf (chainNes target)
_ -> property True
-- | Given a NewEpochState and [ChainEvent], test a Property at every Epoch Boundary
newEpochEventsProp :: Word64 -> ([ChainEvent C] -> NewEpochState C -> Property) -> Property
newEpochEventsProp tracelen propf = withMaxSuccess 10 $
forEachEpochTrace @C 10 tracelen $ \tr ->
forEachEpochTrace @C 10 tracelen defaultConstants $ \tr ->
case lastElem (sourceSignalTargets tr) of
Just SourceSignalTarget {target} ->
propf (concat (runShelleyBase $ getEvents tr)) (chainNes target)
) where
import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.BaseTypes (Globals, StrictMaybe (..))
import Cardano.Ledger.BaseTypes (Globals, StrictMaybe (..), natVersion)
import Cardano.Ledger.Block (
Block (..),
bbody,
import Lens.Micro hiding (ix)
import Lens.Micro.Extras (view)
import Test.Cardano.Ledger.Shelley.Generator.Block (tickChainState)
import Test.Cardano.Ledger.Shelley.Generator.Constants (Constants, defaultConstants)
import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..))
import qualified Test.Cardano.Ledger.Shelley.Generator.Presets as Preset (genEnv)
) =>
Property
adaIsPreserved =
forAllChainTrace @era longTraceLen $ \tr -> do
forAllChainTrace @era longTraceLen defaultConstants $ \tr -> do
let ssts :: [SourceSignalTarget (CHAIN era)]
-- Signal(CHAIN era) = Block (BHeader (EraCrypto era)) era
ssts = sourceSignalTargets tr
) =>
Property
collisionFreeComplete =
forAllChainTrace @era traceLen $ \tr -> do
forAllChainTrace @era traceLen defaultConstants $ \tr -> do
let ssts = sourceSignalTargets tr
conjoin . concat $
[ -- collision freeness
) =>
Property
stakeIncrTest =
forAllChainTrace @era longTraceLen $ \tr -> do
forAllChainTrace @era longTraceLen defaultConstants $ \tr -> do
let ssts = sourceSignalTargets tr
conjoin . concat $
) =>
Property
adaPreservationChain =
forAllChainTrace @era longTraceLen $ \tr -> do
forAllChainTrace @era longTraceLen defaultConstants $ \tr -> do
let ssts :: [SourceSignalTarget (CHAIN era)]
-- In this test, the STS Signal has this definition
-- Signal(CHAIN era) = Block (BHeader (EraCrypto era)) era
) =>
(SourceSignalTarget (CHAIN era) -> Property) ->
Property
shortChainTrace f = withMaxSuccess 100 $ forAllChainTrace @era 10 $ \tr -> conjoin (map f (sourceSignalTargets tr))
shortChainTrace f = withMaxSuccess 100 $ forAllChainTrace @era 10 defaultConstants $ \tr -> conjoin (map f (sourceSignalTargets tr))
-- | Tests that redundant Deposit information is consistent
depositTests ::
) =>
Property
poolProperties =
forAllChainTrace @era traceLen $ \tr -> do
forAllChainTrace @era traceLen defaultConstants $ \tr -> do
let ssts = sourceSignalTargets tr
conjoin . concat $
[ map poolRetirement ssts
) =>
Property
delegProperties =
forAllChainTrace @era traceLen $ \tr -> do
forAllChainTrace @era traceLen defaultConstants $ \tr -> do
conjoin $
map chainProp (sourceSignalTargets tr)
where
) =>
Property
removedAfterPoolreap =
forAllChainTrace traceLen $ \tr ->
forAllChainTrace traceLen defaultConstants $ \tr ->
conjoin $
map removedAfterPoolreap_ $
filter (not . sameEpoch) (chainSstWithTick tr)
, EraTallyState era
) =>
Word64 -> -- trace length
Constants ->
(Trace (CHAIN era) -> prop) ->
Property
forAllChainTrace n prop =
forAllChainTrace n constants prop =
withMaxSuccess (fromIntegral numberOfTests) . property $
forAllTraceFromInitState
testGlobals
n
(Preset.genEnv p defaultConstants)
(Just $ mkGenesisChainState (Preset.genEnv p defaultConstants))
(Preset.genEnv p constants)
(Just $ mkGenesisChainState (Preset.genEnv p constants))
prop
where
p :: Proxy era
) =>
Int ->
Word64 ->
Constants ->
(Trace (CHAIN era) -> prop) ->
Property
forEachEpochTrace subtracecount tracelen f = forAllChainTrace tracelen action
forEachEpochTrace subtracecount tracelen constants f = forAllChainTrace tracelen constants action
where
-- split at contiguous elements with different Epoch numbers
p new old = (nesEL . chainNes) new /= (nesEL . chainNes) old
(EpochState era -> prop) ->
Property
atEpoch f =
forAllChainTrace traceLen $ \tr ->
forAllChainTrace traceLen defaultConstants $ \tr ->
conjoin $
map (\(SourceSignalTarget s _ _) -> (f . nesEs . chainNes) s) $
filter (not . sameEpoch) (sourceSignalTargets tr)
I don't trust it. Compare these two runs: 1. https://github.com/input-output-hk/cardano-haskell-packages/actions/runs/4532746158/jobs/7984714895 2. https://github.com/input-output-hk/cardano-haskell-packages/actions/runs/4516172089/jobs/7954255360 The second is on the parent commit of the first, the commit itself is a no-op, and yet the derivations they build are not the same! Doing the same locally, I get a) a different derivation, but b) the same derivation for both. I conclude that what the CI is doing is questionable, the cache seems like the most likely source of pollution. I suspect whatever is causing this was also responsible for the no-op PR spending a lot of time building tons of stuff.
Co-authored-by: Sebastien Guillemot <[email protected]>
5018: Use ouroboros-network-0.3.0.2 and ouroboros-network-framework-0.2.0.1 r=dermetfan a=coot Co-authored-by: Marcin Szamotulski <[email protected]> Co-authored-by: Samuel Leathers <[email protected]>
Waiting for a day, at a pace of one block every 20 seconds would generate 4320 blocks which takes forever to be created and processes, even in IO sim. We don't really observe the issue now because we cheat in the way we generate the block. This commit helps preparing for a more realistic block generation.
Everyone collects after observing the last commit
That way, we try to get closer to an actual block production pattern.