{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Protocol.TPraos.Arbitrary (
  genBHeader,
  genBlock,
  genCoherentBlock,
  VRFNatVal (..),
) where

import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util (SignableRepresentation)
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BaseTypes (BlockNo (..), Nonce, Seed, SlotNo (..))
import Cardano.Ledger.Block (Block (Block))
import Cardano.Ledger.Core
import Cardano.Protocol.Crypto (Crypto (KES, VRF), StandardCrypto)
import Cardano.Protocol.TPraos.API (ChainDepState, PraosCrypto)
import Cardano.Protocol.TPraos.BHeader (
  BHBody (BHBody),
  BHeader (BHeader),
  PrevHash (BlockHash, GenesisHash),
 )
import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod), OCert (..))
import Cardano.Protocol.TPraos.Rules.Overlay (OBftSlot)
import Cardano.Protocol.TPraos.Rules.Prtcl (PrtclState)
import Cardano.Protocol.TPraos.Rules.Tickn (TicknState)
import Data.Proxy (Proxy (Proxy))
import Generic.Random (genericArbitraryU)
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Arbitrary ()
import Test.Cardano.Protocol.TPraos.Create (AllIssuerKeys, mkBHBody, mkBHeader, mkBlock, mkOCert)

instance Arbitrary ChainDepState where
  arbitrary :: Gen ChainDepState
arbitrary = Gen ChainDepState
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ChainDepState -> [ChainDepState]
shrink = ChainDepState -> [ChainDepState]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

newtype VRFNatVal = VRFNatVal Natural
  deriving (Int -> VRFNatVal -> ShowS
[VRFNatVal] -> ShowS
VRFNatVal -> String
(Int -> VRFNatVal -> ShowS)
-> (VRFNatVal -> String)
-> ([VRFNatVal] -> ShowS)
-> Show VRFNatVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VRFNatVal -> ShowS
showsPrec :: Int -> VRFNatVal -> ShowS
$cshow :: VRFNatVal -> String
show :: VRFNatVal -> String
$cshowList :: [VRFNatVal] -> ShowS
showList :: [VRFNatVal] -> ShowS
Show)

instance Arbitrary VRFNatVal where
  arbitrary :: Gen VRFNatVal
arbitrary =
    Nat -> VRFNatVal
VRFNatVal (Nat -> VRFNatVal) -> (Integer -> Nat) -> Integer -> VRFNatVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Integer -> VRFNatVal) -> Gen Integer -> Gen VRFNatVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose @Integer
        ( Integer
0
        , Integer
2
            Integer -> Word -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ ( Word
8
                  Word -> Word -> Word
forall a. Num a => a -> a -> a
* Proxy PraosVRF -> Word
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
forall (proxy :: * -> *). proxy PraosVRF -> Word
VRF.sizeOutputVRF
                    (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VRF StandardCrypto))
              )
        )
  shrink :: VRFNatVal -> [VRFNatVal]
shrink (VRFNatVal Nat
v) = Nat -> VRFNatVal
VRFNatVal (Nat -> VRFNatVal) -> [Nat] -> [VRFNatVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Nat -> [Nat]
forall a. Integral a => a -> [a]
shrinkIntegral Nat
v

instance Arbitrary HashHeader where
  arbitrary :: Gen HashHeader
arbitrary = Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader (Hash HASH EraIndependentBlockHeader -> HashHeader)
-> Gen (Hash HASH EraIndependentBlockHeader) -> Gen HashHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash HASH EraIndependentBlockHeader)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary TicknState where
  arbitrary :: Gen TicknState
arbitrary = Gen TicknState
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: TicknState -> [TicknState]
shrink = TicknState -> [TicknState]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary PrtclState where
  arbitrary :: Gen PrtclState
arbitrary = Gen PrtclState
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: PrtclState -> [PrtclState]
shrink = PrtclState -> [PrtclState]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary OBftSlot where
  arbitrary :: Gen OBftSlot
arbitrary = Gen OBftSlot
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: OBftSlot -> [OBftSlot]
shrink = OBftSlot -> [OBftSlot]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance
  ( Crypto c
  , VRF.Signable (VRF c) ~ SignableRepresentation
  , KES.Signable (KES c) ~ SignableRepresentation
  ) =>
  Arbitrary (BHeader c)
  where
  arbitrary :: Gen (BHeader c)
arbitrary = do
    bhBody <- Gen (BHBody c)
forall a. Arbitrary a => Gen a
arbitrary
    hotKey <- arbitrary
    let sig = ContextKES (KES c)
-> Word
-> BHBody c
-> UnsoundPureSignKeyKES (KES c)
-> SignedKES (KES c) (BHBody c)
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
KES.unsoundPureSignedKES () Word
1 BHBody c
bhBody UnsoundPureSignKeyKES (KES c)
hotKey
    pure $ BHeader bhBody sig

genBHeader ::
  ( VRF.Signable (VRF c) Seed
  , KES.Signable (KES c) (BHBody c)
  , Crypto c
  ) =>
  [AllIssuerKeys c r] ->
  Gen (BHeader c)
genBHeader :: forall c (r :: KeyRole).
(Signable (VRF c) Seed, Signable (KES c) (BHBody c), Crypto c) =>
[AllIssuerKeys c r] -> Gen (BHeader c)
genBHeader [AllIssuerKeys c r]
aiks = do
  prevHash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary
  allPoolKeys <- elements aiks
  slotNo <- arbitrary
  blockNo <- arbitrary
  epochNonce <- arbitrary
  bodySize <- arbitrary
  bodyHash <- arbitrary
  protVer <- arbitrary
  let kesPeriod = Word
1
      keyRegKesPeriod = Word
1
      oCert = AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys c r
allPoolKeys Word64
1 (Word -> KESPeriod
KESPeriod Word
kesPeriod)
      bhBody =
        ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
forall c (r :: KeyRole).
(ContextVRF (VRF c) ~ (), Signable (VRF c) Seed,
 VRFAlgorithm (VRF c)) =>
ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBody ProtVer
protVer HashHeader
prevHash AllIssuerKeys c r
allPoolKeys SlotNo
slotNo BlockNo
blockNo Nonce
epochNonce OCert c
oCert Word32
bodySize Hash HASH EraIndependentBlockBody
bodyHash
  return $ mkBHeader allPoolKeys kesPeriod keyRegKesPeriod bhBody

instance
  ( Crypto c
  , VRF.Signable (VRF c) ~ SignableRepresentation
  ) =>
  Arbitrary (BHBody c)
  where
  arbitrary :: Gen (BHBody c)
arbitrary =
    BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) Nonce
-> CertifiedVRF (VRF c) Nat
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> BHBody c
forall c.
BlockNo
-> SlotNo
-> PrevHash
-> VKey 'BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) Nonce
-> CertifiedVRF (VRF c) Nat
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> BHBody c
BHBody
      (BlockNo
 -> SlotNo
 -> PrevHash
 -> VKey 'BlockIssuer
 -> VerKeyVRF (VRF c)
 -> CertifiedVRF (VRF c) Nonce
 -> CertifiedVRF (VRF c) Nat
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert c
 -> ProtVer
 -> BHBody c)
-> Gen BlockNo
-> Gen
     (SlotNo
      -> PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen BlockNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (SlotNo
   -> PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen SlotNo
-> Gen
     (PrevHash
      -> VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (PrevHash
   -> VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen PrevHash
-> Gen
     (VKey 'BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PrevHash
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VKey 'BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (VKey 'BlockIssuer)
-> Gen
     (VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VKey 'BlockIssuer)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
     (CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VerKeyVRF (VRF c))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (CertifiedVRF (VRF c) Nonce)
-> Gen
     (CertifiedVRF (VRF c) Nat
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertifiedVRF (VRF c) Nonce)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CertifiedVRF (VRF c) Nat
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (CertifiedVRF (VRF c) Nat)
-> Gen
     (Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertifiedVRF (VRF c) Nat)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen Word32
-> Gen
     (Hash HASH EraIndependentBlockBody
      -> OCert c -> ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Hash HASH EraIndependentBlockBody
   -> OCert c -> ProtVer -> BHBody c)
-> Gen (Hash HASH EraIndependentBlockBody)
-> Gen (OCert c -> ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Hash HASH EraIndependentBlockBody)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (OCert c -> ProtVer -> BHBody c)
-> Gen (OCert c) -> Gen (ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (OCert c)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (ProtVer -> BHBody c) -> Gen ProtVer -> Gen (BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtVer
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PrevHash where
  arbitrary :: Gen PrevHash
arbitrary = do
    hash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary
    frequency [(1, pure GenesisHash), (9999, pure (BlockHash hash))]

instance Crypto c => Arbitrary (OCert c) where
  arbitrary :: Gen (OCert c)
arbitrary =
    VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
OCert
      (VerKeyKES (KES c)
 -> Word64
 -> KESPeriod
 -> SignedDSIGN DSIGN (OCertSignable c)
 -> OCert c)
-> Gen (VerKeyKES (KES c))
-> Gen
     (Word64
      -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word64
   -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen Word64
-> Gen
     (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
      Gen (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen KESPeriod
-> Gen (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen KESPeriod
forall a. Arbitrary a => Gen a
arbitrary
      Gen (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen (SignedDSIGN DSIGN (OCertSignable c)) -> Gen (OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SignedDSIGN DSIGN (OCertSignable c))
forall a. Arbitrary a => Gen a
arbitrary

deriving newtype instance Arbitrary KESPeriod

instance
  ( Crypto c
  , EraBlockBody era
  , KES.Signable (KES c) ~ SignableRepresentation
  , VRF.Signable (VRF c) ~ SignableRepresentation
  , Arbitrary (Tx TopTx era)
  , Arbitrary (BlockBody era)
  ) =>
  Arbitrary (Block (BHeader c) era)
  where
  arbitrary :: Gen (Block (BHeader c) era)
arbitrary =
    BHeader c -> BlockBody era -> Block (BHeader c) era
forall h era. h -> BlockBody era -> Block h era
Block
      (BHeader c -> BlockBody era -> Block (BHeader c) era)
-> Gen (BHeader c) -> Gen (BlockBody era -> Block (BHeader c) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BHeader c)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (BlockBody era -> Block (BHeader c) era)
-> Gen (BlockBody era) -> Gen (Block (BHeader c) era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (BlockBody era)
forall a. Arbitrary a => Gen a
arbitrary

-- | Use supplied keys to generate a Block.
genBlock ::
  ( Crypto c
  , VRF.Signable (VRF c) Seed
  , KES.Signable (KES c) (BHBody c)
  , Arbitrary (BlockBody era)
  ) =>
  [AllIssuerKeys c r] ->
  Gen (Block (BHeader c) era)
genBlock :: forall c era (r :: KeyRole).
(Crypto c, Signable (VRF c) Seed, Signable (KES c) (BHBody c),
 Arbitrary (BlockBody era)) =>
[AllIssuerKeys c r] -> Gen (Block (BHeader c) era)
genBlock [AllIssuerKeys c r]
aiks =
  BHeader c -> BlockBody era -> Block (BHeader c) era
forall h era. h -> BlockBody era -> Block h era
Block
    (BHeader c -> BlockBody era -> Block (BHeader c) era)
-> Gen (BHeader c) -> Gen (BlockBody era -> Block (BHeader c) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys c r] -> Gen (BHeader c)
forall c (r :: KeyRole).
(Signable (VRF c) Seed, Signable (KES c) (BHBody c), Crypto c) =>
[AllIssuerKeys c r] -> Gen (BHeader c)
genBHeader [AllIssuerKeys c r]
aiks
    Gen (BlockBody era -> Block (BHeader c) era)
-> Gen (BlockBody era) -> Gen (Block (BHeader c) era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (BlockBody era)
forall a. Arbitrary a => Gen a
arbitrary

-- | For some purposes, a totally random block generator may not be suitable.
-- There are tests in the ouroboros-network repository, for instance, that
-- perform some integrity checks on the generated blocks.
--
-- For other purposes, such as the serialization tests in this repository,
-- 'genBlock' is more appropriate.
--
-- This generator uses 'mkBlock' provide more coherent blocks.
genCoherentBlock ::
  forall era r c.
  ( EraBlockBody era
  , Arbitrary (Tx TopTx era)
  , KES.Signable (KES c) ~ SignableRepresentation
  , PraosCrypto c
  ) =>
  [AllIssuerKeys c r] ->
  Gen (Block (BHeader c) era)
genCoherentBlock :: forall era (r :: KeyRole) c.
(EraBlockBody era, Arbitrary (Tx TopTx era),
 Signable (KES c) ~ SignableRepresentation, PraosCrypto c) =>
[AllIssuerKeys c r] -> Gen (Block (BHeader c) era)
genCoherentBlock [AllIssuerKeys c r]
aiks = do
  prevHash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary :: Gen HashHeader
  allPoolKeys <- elements aiks
  txs <- arbitrary
  curSlotNo <- SlotNo <$> choose (0, 10)
  curBlockNo <- BlockNo <$> choose (0, 100)
  epochNonce <- arbitrary :: Gen Nonce
  let kesPeriod = Word
1
      keyRegKesPeriod = Word
1
      ocert = AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys c r
allPoolKeys Word64
1 (Word -> KESPeriod
KESPeriod Word
kesPeriod)
  return $
    mkBlock
      prevHash
      allPoolKeys
      txs
      curSlotNo
      curBlockNo
      epochNonce
      kesPeriod
      keyRegKesPeriod
      ocert