{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Test that the Peras certificate inclusion rules can correctly decide when
-- to include a certificate
--
-- NOTE: in this file, we use uncommon variable names such as `_A` because that
-- is their name in the CIP-0140, and we can't have variable names starting
-- with capital letters. Contrary to typical Haskell conventions, those do not
-- denote ignored variables.
module Test.Consensus.Peras.Cert.Inclusion (tests) where

import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block (Point (..), WithOrigin (..))
import Ouroboros.Consensus.Block.SupportsPeras
  ( BoostedBlock
  , IsPerasCert (..)
  , PerasCertMaxRounds (..)
  , PerasParams (..)
  , PerasRoundNo (..)
  , defaultPerasParams
  )
import Ouroboros.Consensus.Peras.Cert.Inclusion
  ( LatestCertOnChainView (..)
  , LatestCertSeenView (..)
  , PerasCertInclusionRulesDecision (..)
  , PerasCertInclusionView (..)
  , needCert
  )
import Ouroboros.Consensus.Util.Pred (Evidence (..))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck
  ( Arbitrary (..)
  , Gen
  , Property
  , Testable (..)
  , choose
  , counterexample
  , forAll
  , frequency
  , tabulate
  , testProperty
  )
import Test.Util.QuickCheck (geometric)
import Test.Util.TestBlock (TestBlock)
import Test.Util.TestEnv (adjustQuickCheckTests)

{-------------------------------------------------------------------------------
  Tests
-------------------------------------------------------------------------------}

tests :: TestTree
tests :: TestTree
tests =
  (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestTree] -> TestTree
testGroup
      TestName
"Peras certificate inclusion rules"
      [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"needCert" Property
prop_needCert
      ]

{-------------------------------------------------------------------------------
  Model conformance test property
-------------------------------------------------------------------------------}

data PerasCertInclusionRulesDecisionModel
  = PerasCertInclusionDecisionModel
  { PerasCertInclusionRulesDecisionModel -> Bool
shouldIncludeCert :: Bool
  , PerasCertInclusionRulesDecisionModel -> Bool
noCertsFromTwoRoundsAgo :: Bool
  , PerasCertInclusionRulesDecisionModel -> Bool
latestCertSeenIsNotExpired :: Bool
  , PerasCertInclusionRulesDecisionModel -> Bool
latestCertSeenIsNewerThanLatestCertOnChain :: Bool
  }

-- | A simplified model of the Peras certificate inclusion rules, used to compare
-- against the real implementation. The main difference is that this model computes
-- the result of the predicate directly over the inputs, rather than using the
-- 'Pred' combinators to produce evidence in either direction.
--
-- NOTE: this predicate could be lifted directly from the agda specification.
needCertModel ::
  PerasCertInclusionView TestCert TestBlock ->
  PerasCertInclusionRulesDecisionModel
needCertModel :: PerasCertInclusionView TestCert TestBlock
-> PerasCertInclusionRulesDecisionModel
needCertModel
  PerasCertInclusionView
    { PerasParams TestBlock
perasParams :: PerasParams TestBlock
perasParams :: forall cert blk. PerasCertInclusionView cert blk -> PerasParams blk
perasParams
    , PerasRoundNo
currRoundNo :: PerasRoundNo
currRoundNo :: forall cert blk. PerasCertInclusionView cert blk -> PerasRoundNo
currRoundNo
    , LatestCertSeenView TestCert
latestCertSeen :: LatestCertSeenView TestCert
latestCertSeen :: forall cert blk.
PerasCertInclusionView cert blk -> LatestCertSeenView cert
latestCertSeen
    , WithOrigin (LatestCertOnChainView TestCert)
latestCertOnChain :: WithOrigin (LatestCertOnChainView TestCert)
latestCertOnChain :: forall cert blk.
PerasCertInclusionView cert blk
-> WithOrigin (LatestCertOnChainView cert)
latestCertOnChain
    , Set PerasRoundNo
certIds :: Set PerasRoundNo
certIds :: forall cert blk.
PerasCertInclusionView cert blk -> Set PerasRoundNo
certIds
    } =
    PerasCertInclusionDecisionModel
      { shouldIncludeCert :: Bool
shouldIncludeCert =
          Bool
noCertsFromTwoRoundsAgo
            Bool -> Bool -> Bool
&& Bool
latestCertSeenIsNotExpired
            Bool -> Bool -> Bool
&& Bool
latestCertSeenIsNewerThanLatestCertOnChain
      , noCertsFromTwoRoundsAgo :: Bool
noCertsFromTwoRoundsAgo =
          Bool
noCertsFromTwoRoundsAgo
      , latestCertSeenIsNotExpired :: Bool
latestCertSeenIsNotExpired =
          Bool
latestCertSeenIsNotExpired
      , latestCertSeenIsNewerThanLatestCertOnChain :: Bool
latestCertSeenIsNewerThanLatestCertOnChain =
          Bool
latestCertSeenIsNewerThanLatestCertOnChain
      }
   where
    noCertsFromTwoRoundsAgo :: Bool
noCertsFromTwoRoundsAgo =
      if PerasRoundNo
currRoundNo PerasRoundNo -> PerasRoundNo -> Bool
forall a. Ord a => a -> a -> Bool
< PerasRoundNo
2
        then Bool
False
        else Bool -> Bool
not ((PerasRoundNo
currRoundNo PerasRoundNo -> PerasRoundNo -> PerasRoundNo
forall a. Num a => a -> a -> a
- PerasRoundNo
2) PerasRoundNo -> Set PerasRoundNo -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PerasRoundNo
certIds)

    latestCertSeenIsNotExpired :: Bool
latestCertSeenIsNotExpired =
      PerasRoundNo
currRoundNo
        PerasRoundNo -> PerasRoundNo -> Bool
forall a. Ord a => a -> a -> Bool
<= PerasRoundNo
_A PerasRoundNo -> PerasRoundNo -> PerasRoundNo
forall a. Num a => a -> a -> a
+ TestCert -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound (LatestCertSeenView TestCert -> TestCert
forall cert. LatestCertSeenView cert -> cert
lcsCert LatestCertSeenView TestCert
latestCertSeen)

    latestCertSeenIsNewerThanLatestCertOnChain :: Bool
latestCertSeenIsNewerThanLatestCertOnChain =
      case WithOrigin (LatestCertOnChainView TestCert)
latestCertOnChain of
        WithOrigin (LatestCertOnChainView TestCert)
Origin -> Bool
True
        NotOrigin LatestCertOnChainView TestCert
lcoc ->
          TestCert -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound (LatestCertSeenView TestCert -> TestCert
forall cert. LatestCertSeenView cert -> cert
lcsCert LatestCertSeenView TestCert
latestCertSeen) PerasRoundNo -> PerasRoundNo -> Bool
forall a. Ord a => a -> a -> Bool
> LatestCertOnChainView TestCert -> PerasRoundNo
forall cert. LatestCertOnChainView cert -> PerasRoundNo
lcocRoundNo LatestCertOnChainView TestCert
lcoc

    _A :: PerasRoundNo
_A =
      Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Word64 -> PerasRoundNo
forall a b. (a -> b) -> a -> b
$
        PerasCertMaxRounds -> Word64
unPerasCertMaxRounds (PerasCertMaxRounds -> Word64) -> PerasCertMaxRounds -> Word64
forall a b. (a -> b) -> a -> b
$
          PerasParams TestBlock -> PerasCertMaxRounds
forall blk. PerasParams blk -> PerasCertMaxRounds
perasCertMaxRounds (PerasParams TestBlock -> PerasCertMaxRounds)
-> PerasParams TestBlock -> PerasCertMaxRounds
forall a b. (a -> b) -> a -> b
$
            PerasParams TestBlock
perasParams

-- | Test that the Peras certificate inclusion rules can correctly decide when
-- to include a certificate based on a simplified model that doesn't use anything
-- fancy to evaluate the rules.
prop_needCert :: Property
prop_needCert :: Property
prop_needCert = Gen (PerasCertInclusionView TestCert TestBlock)
-> (PerasCertInclusionView TestCert TestBlock -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (PerasCertInclusionView TestCert TestBlock)
genPerasCertInclusionView ((PerasCertInclusionView TestCert TestBlock -> Property)
 -> Property)
-> (PerasCertInclusionView TestCert TestBlock -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \PerasCertInclusionView TestCert TestBlock
pciv -> do
  -- Determine whether we should include a cert according to the model
  let PerasCertInclusionDecisionModel
        { Bool
shouldIncludeCert :: PerasCertInclusionRulesDecisionModel -> Bool
shouldIncludeCert :: Bool
shouldIncludeCert
        , Bool
noCertsFromTwoRoundsAgo :: PerasCertInclusionRulesDecisionModel -> Bool
noCertsFromTwoRoundsAgo :: Bool
noCertsFromTwoRoundsAgo
        , Bool
latestCertSeenIsNotExpired :: PerasCertInclusionRulesDecisionModel -> Bool
latestCertSeenIsNotExpired :: Bool
latestCertSeenIsNotExpired
        , Bool
latestCertSeenIsNewerThanLatestCertOnChain :: PerasCertInclusionRulesDecisionModel -> Bool
latestCertSeenIsNewerThanLatestCertOnChain :: Bool
latestCertSeenIsNewerThanLatestCertOnChain
        } =
          PerasCertInclusionView TestCert TestBlock
-> PerasCertInclusionRulesDecisionModel
needCertModel PerasCertInclusionView TestCert TestBlock
pciv
  -- Some helper functions to report success/failure
  let chain :: [t -> t] -> t -> t
chain = (t -> [t -> t] -> t) -> [t -> t] -> t -> t
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((t -> t) -> t -> t) -> t -> [t -> t] -> t
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
($)) ([t -> t] -> t -> t)
-> ([t -> t] -> [t -> t]) -> [t -> t] -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t -> t] -> [t -> t]
forall a. [a] -> [a]
reverse
  let ok :: TestName -> Property
ok TestName
desc =
        [Property -> Property] -> Property -> Property
forall {t}. [t -> t] -> t -> t
chain
          [ TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"NoCertsFromTwoRoundsAgo" [Bool -> TestName
forall a. Show a => a -> TestName
show Bool
noCertsFromTwoRoundsAgo]
          , TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"LatestCertSeenIsNotExpired" [Bool -> TestName
forall a. Show a => a -> TestName
show Bool
latestCertSeenIsNotExpired]
          , TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate
              TestName
"LatestCertSeenIsNewerThanLatestCertOnChain"
              [Bool -> TestName
forall a. Show a => a -> TestName
show Bool
latestCertSeenIsNewerThanLatestCertOnChain]
          , TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate
              TestName
"NoCertsFromTwoRoundsAgo|LatestCertSeenIsNotExpired|LatestCertSeenIsNewerThanLatestCertOnChain"
              [ (Bool, Bool, Bool) -> TestName
forall a. Show a => a -> TestName
show
                  ( Bool
noCertsFromTwoRoundsAgo
                  , Bool
latestCertSeenIsNotExpired
                  , Bool
latestCertSeenIsNewerThanLatestCertOnChain
                  )
              ]
          , TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"Should include cert according to model" [Bool -> TestName
forall a. Show a => a -> TestName
show Bool
shouldIncludeCert]
          , TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"Actual result" [TestName
desc]
          ]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
  let failure :: TestName -> Property
failure TestName
desc =
        TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
desc (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
  -- Now check that the real implementation agrees with the model
  let certInclusionDecision :: PerasCertInclusionRulesDecision TestCert
certInclusionDecision = PerasCertInclusionView TestCert TestBlock
-> PerasCertInclusionRulesDecision TestCert
forall cert blk.
PerasCertInclusionView cert blk
-> PerasCertInclusionRulesDecision cert
needCert PerasCertInclusionView TestCert TestBlock
pciv
  case PerasCertInclusionRulesDecision TestCert
certInclusionDecision of
    IncludeCert (ETrue Pred PerasCertInclusionRule
_includeCertReason) TestCert
_cert
      | Bool
shouldIncludeCert ->
          TestName -> Property
ok (TestName -> Property) -> TestName -> Property
forall a b. (a -> b) -> a -> b
$ PerasCertInclusionRulesDecision TestCert -> TestName
forall cert. PerasCertInclusionRulesDecision cert -> TestName
certInclusionDecisionTag PerasCertInclusionRulesDecision TestCert
certInclusionDecision
      | Bool
otherwise ->
          TestName -> Property
failure (TestName -> Property) -> TestName -> Property
forall a b. (a -> b) -> a -> b
$ TestName
"Expected not to include cert, but got: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> PerasCertInclusionRulesDecision TestCert -> TestName
forall a. Show a => a -> TestName
show PerasCertInclusionRulesDecision TestCert
certInclusionDecision
    DoNotIncludeCert (EFalse Pred PerasCertInclusionRule
_doNotIncludeCertReason)
      | Bool -> Bool
not Bool
shouldIncludeCert ->
          TestName -> Property
ok (TestName -> Property) -> TestName -> Property
forall a b. (a -> b) -> a -> b
$ PerasCertInclusionRulesDecision TestCert -> TestName
forall cert. PerasCertInclusionRulesDecision cert -> TestName
certInclusionDecisionTag PerasCertInclusionRulesDecision TestCert
certInclusionDecision
      | Bool
otherwise ->
          TestName -> Property
failure (TestName -> Property) -> TestName -> Property
forall a b. (a -> b) -> a -> b
$ TestName
"Expected to include cert, but got: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> PerasCertInclusionRulesDecision TestCert -> TestName
forall a. Show a => a -> TestName
show PerasCertInclusionRulesDecision TestCert
certInclusionDecision

-- | Tag for the certificate inclusion decision result, used for tabulation.
--
-- We use this instead of 'explainShallow' to avoid creating too many unique
-- strings for tabulation (explainShallow includes round numbers which would
-- create millions of distinct cases, making the tabulation output useless).
certInclusionDecisionTag :: PerasCertInclusionRulesDecision cert -> String
certInclusionDecisionTag :: forall cert. PerasCertInclusionRulesDecision cert -> TestName
certInclusionDecisionTag = \case
  IncludeCert{} -> TestName
"IncludeCert"
  DoNotIncludeCert{} -> TestName
"DoNotIncludeCert"

{-------------------------------------------------------------------------------
  Arbitrary helpers
-------------------------------------------------------------------------------}

-- * Peras parameters

-- NOTE: we use a geometric distribution to bias towards smaller values.
-- This increases the chance of covering all the inclusion rules more evenly,
-- while still allowing for larger values to be generated occasionally.
--
-- Moreover, geometric(0.5) + 1 means that:
--  - 50% chance of being 1
--  - 25% chance of being 2
--  - 12.5% chance of being 3
--  ... and so on
genPerasParams :: Gen (PerasParams blk)
genPerasParams :: forall blk. Gen (PerasParams blk)
genPerasParams = do
  _A <- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Int -> Int) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word64) -> Gen Int -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Gen Int
geometric Double
0.5
  pure
    defaultPerasParams
      { perasCertMaxRounds = PerasCertMaxRounds _A
      }

-- * Peras round numbers

-- | Generate a Peras round number.
--
-- We skew the distribution towards the first two rounds to cover the edge cases
-- in the certificate inclusion rules a bit more often.
genPerasRoundNo :: Gen PerasRoundNo
genPerasRoundNo :: Gen PerasRoundNo
genPerasRoundNo =
  [(Int, Gen PerasRoundNo)] -> Gen PerasRoundNo
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, PerasRoundNo -> Gen PerasRoundNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> PerasRoundNo
PerasRoundNo Word64
0))
    , (Int
1, PerasRoundNo -> Gen PerasRoundNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> PerasRoundNo
PerasRoundNo Word64
1))
    , (Int
8, Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Gen Word64 -> Gen PerasRoundNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)
    ]

-- * Mocked certificate type

-- | A mocked certificate type for testing, so we don't have to deal with
-- development changes in the real certificate type.
data TestCert
  = TestCert
  { TestCert -> PerasRoundNo
tcRoundNo :: PerasRoundNo
  }
  deriving (Int -> TestCert -> TestName -> TestName
[TestCert] -> TestName -> TestName
TestCert -> TestName
(Int -> TestCert -> TestName -> TestName)
-> (TestCert -> TestName)
-> ([TestCert] -> TestName -> TestName)
-> Show TestCert
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Int -> TestCert -> TestName -> TestName
showsPrec :: Int -> TestCert -> TestName -> TestName
$cshow :: TestCert -> TestName
show :: TestCert -> TestName
$cshowList :: [TestCert] -> TestName -> TestName
showList :: [TestCert] -> TestName -> TestName
Show, TestCert -> TestCert -> Bool
(TestCert -> TestCert -> Bool)
-> (TestCert -> TestCert -> Bool) -> Eq TestCert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestCert -> TestCert -> Bool
== :: TestCert -> TestCert -> Bool
$c/= :: TestCert -> TestCert -> Bool
/= :: TestCert -> TestCert -> Bool
Eq, (forall x. TestCert -> Rep TestCert x)
-> (forall x. Rep TestCert x -> TestCert) -> Generic TestCert
forall x. Rep TestCert x -> TestCert
forall x. TestCert -> Rep TestCert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestCert -> Rep TestCert x
from :: forall x. TestCert -> Rep TestCert x
$cto :: forall x. Rep TestCert x -> TestCert
to :: forall x. Rep TestCert x -> TestCert
Generic)

type instance BoostedBlock TestCert = Point TestBlock

instance IsPerasCert TestCert TestBlock where
  getPerasCertRound :: TestCert -> PerasRoundNo
getPerasCertRound = TestCert -> PerasRoundNo
tcRoundNo

  -- We don't really care about the block being boosted for the inclusion rules
  getPerasCertBlock :: TestCert -> BoostedBlock TestCert
getPerasCertBlock = Point TestBlock -> TestCert -> Point TestBlock
forall a b. a -> b -> a
const Point TestBlock
forall {k} (block :: k). Point block
GenesisPoint

-- | Generate a test certificate
--
-- NOTE: to improve the probabilities of covering all the paths in the code,
-- we generate certificates relative to a given Peras round (the current one).
genTestCert :: PerasRoundNo -> Gen TestCert
genTestCert :: PerasRoundNo -> Gen TestCert
genTestCert PerasRoundNo
roundNo = do
  offset <- forall a. Random a => (a, a) -> Gen a
choose @Integer (-Integer
10, Integer
3)
  -- NOTE: here we need to be careful not to underflow the round number
  let roundNo' =
        Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Word64 -> PerasRoundNo
forall a b. (a -> b) -> a -> b
$
          Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$
            Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$
              Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (PerasRoundNo -> Word64
unPerasRoundNo PerasRoundNo
roundNo) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
offset
  pure $
    TestCert
      { tcRoundNo = roundNo'
      }

-- * Certificate and inclusion views

genLatestCertSeen :: PerasRoundNo -> Gen (LatestCertSeenView TestCert)
genLatestCertSeen :: PerasRoundNo -> Gen (LatestCertSeenView TestCert)
genLatestCertSeen PerasRoundNo
roundNo = do
  cert <- PerasRoundNo -> Gen TestCert
genTestCert PerasRoundNo
roundNo
  pure
    LatestCertSeenView
      { lcsCert = cert
      , lcsCertRound = getPerasCertRound cert
      }

genLatestCertOnChain :: PerasRoundNo -> Gen (LatestCertOnChainView TestCert)
genLatestCertOnChain :: PerasRoundNo -> Gen (LatestCertOnChainView TestCert)
genLatestCertOnChain PerasRoundNo
roundNo = do
  cert <- PerasRoundNo -> Gen TestCert
genTestCert PerasRoundNo
roundNo
  let certRoundNo = TestCert -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound TestCert
cert
  pure $
    LatestCertOnChainView
      { lcocRoundNo = certRoundNo
      }

genPerasCertIds :: PerasRoundNo -> Gen (Set PerasRoundNo)
genPerasCertIds :: PerasRoundNo -> Gen (Set PerasRoundNo)
genPerasCertIds PerasRoundNo
currRoundNo = do
  -- Decide whether to include a cert from two rounds ago
  containsCertFromTwoRoundsAgo <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
  pure $
    if containsCertFromTwoRoundsAgo && currRoundNo >= 2
      then Set.singleton (currRoundNo - 2)
      else Set.empty

genPerasCertInclusionView :: Gen (PerasCertInclusionView TestCert TestBlock)
genPerasCertInclusionView :: Gen (PerasCertInclusionView TestCert TestBlock)
genPerasCertInclusionView = do
  perasParams <- Gen (PerasParams TestBlock)
forall blk. Gen (PerasParams blk)
genPerasParams
  currRoundNo <- genPerasRoundNo
  latestCertSeen <- genLatestCertSeen currRoundNo
  latestCertOnChain <- genWithOrigin (genLatestCertOnChain currRoundNo)
  certIds <- genPerasCertIds currRoundNo
  pure
    PerasCertInclusionView
      { perasParams
      , currRoundNo
      , latestCertSeen = latestCertSeen
      , latestCertOnChain = latestCertOnChain
      , certIds = certIds
      }
 where
  genWithOrigin :: Gen t -> Gen (WithOrigin t)
genWithOrigin Gen t
gen =
    [(Int, Gen (WithOrigin t))] -> Gen (WithOrigin t)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, WithOrigin t -> Gen (WithOrigin t)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin t
forall t. WithOrigin t
Origin)
      , (Int
9, t -> WithOrigin t
forall t. t -> WithOrigin t
NotOrigin (t -> WithOrigin t) -> Gen t -> Gen (WithOrigin t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen t
gen)
      ]