{-# 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 c
bhBody <- Gen (BHBody c)
forall a. Arbitrary a => Gen a
arbitrary
    UnsoundPureSignKeyKES (KES c)
hotKey <- Gen (UnsoundPureSignKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
    let sig :: SignedKES (KES c) (BHBody c)
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
    BHeader c -> Gen (BHeader c)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BHeader c -> Gen (BHeader c)) -> BHeader c -> Gen (BHeader c)
forall a b. (a -> b) -> a -> b
$ BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
BHeader BHBody c
bhBody SignedKES (KES c) (BHBody c)
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
  HashHeader
prevHash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary
  AllIssuerKeys c r
allPoolKeys <- [AllIssuerKeys c r] -> Gen (AllIssuerKeys c r)
forall a. HasCallStack => [a] -> Gen a
elements [AllIssuerKeys c r]
aiks
  SlotNo
slotNo <- Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
  BlockNo
blockNo <- Gen BlockNo
forall a. Arbitrary a => Gen a
arbitrary
  Nonce
epochNonce <- Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary
  Word32
bodySize <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
  Hash HASH EraIndependentBlockBody
bodyHash <- Gen (Hash HASH EraIndependentBlockBody)
forall a. Arbitrary a => Gen a
arbitrary
  ProtVer
protVer <- Gen ProtVer
forall a. Arbitrary a => Gen a
arbitrary
  let kesPeriod :: Word
kesPeriod = Word
1
      keyRegKesPeriod :: Word
keyRegKesPeriod = Word
1
      oCert :: OCert c
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 :: BHBody c
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
  BHeader c -> Gen (BHeader c)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (BHeader c -> Gen (BHeader c)) -> BHeader c -> Gen (BHeader c)
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys c r
allPoolKeys Word
kesPeriod Word
keyRegKesPeriod BHBody c
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
    HashHeader
hash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary
    [(Int, Gen PrevHash)] -> Gen PrevHash
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, PrevHash -> Gen PrevHash
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash
GenesisHash), (Int
9999, PrevHash -> Gen PrevHash
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashHeader -> PrevHash
BlockHash HashHeader
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 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 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 era),
 Signable (KES c) ~ SignableRepresentation, PraosCrypto c) =>
[AllIssuerKeys c r] -> Gen (Block (BHeader c) era)
genCoherentBlock [AllIssuerKeys c r]
aiks = do
  HashHeader
prevHash <- Gen HashHeader
forall a. Arbitrary a => Gen a
arbitrary :: Gen HashHeader
  AllIssuerKeys c r
allPoolKeys <- [AllIssuerKeys c r] -> Gen (AllIssuerKeys c r)
forall a. HasCallStack => [a] -> Gen a
elements [AllIssuerKeys c r]
aiks
  [Tx era]
txs <- Gen [Tx era]
forall a. Arbitrary a => Gen a
arbitrary
  SlotNo
curSlotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
10)
  BlockNo
curBlockNo <- Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Gen Word64 -> Gen BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
100)
  Nonce
epochNonce <- Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary :: Gen Nonce
  let kesPeriod :: Word
kesPeriod = Word
1
      keyRegKesPeriod :: Word
keyRegKesPeriod = Word
1
      ocert :: OCert c
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)
  Block (BHeader c) era -> Gen (Block (BHeader c) era)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block (BHeader c) era -> Gen (Block (BHeader c) era))
-> Block (BHeader c) era -> Gen (Block (BHeader c) era)
forall a b. (a -> b) -> a -> b
$
    HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
forall era (r :: KeyRole) c.
(Crypto c, EraBlockBody era, Signable (VRF c) Seed,
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlock
      HashHeader
prevHash
      AllIssuerKeys c r
allPoolKeys
      [Tx era]
txs
      SlotNo
curSlotNo
      BlockNo
curBlockNo
      Nonce
epochNonce
      Word
kesPeriod
      Word
keyRegKesPeriod
      OCert c
ocert