{-# LANGUAGE PatternSynonyms #-}

module Test.Cardano.Chain.Block.Gen (
  genBlockSignature,
  genHeaderHash,
  genHeader,
  genBody,
  genProof,
  genToSign,
  genBlock,
  genBlockWithEpochSlots,
  genBoundaryBlock,
  genBoundaryHeader,
  genABlockOrBoundaryHdr,
) where

import Cardano.Chain.Block (
  ABlockOrBoundaryHdr (..),
  ABlockSignature (..),
  ABoundaryBlock (..),
  ABoundaryBody (..),
  ABoundaryHeader (..),
  AHeader,
  Block,
  BlockSignature,
  Body,
  Header,
  HeaderHash,
  Proof (..),
  ToSign (..),
  decCBORABoundaryHeader,
  decCBORAHeader,
  encCBORABoundaryHeader,
  encCBORHeader,
  hashHeader,
  mkABoundaryHeader,
  mkBlockExplicit,
  mkHeaderExplicit,
  pattern Body,
 )
import Cardano.Chain.Byron.API (reAnnotateUsing)
import Cardano.Chain.Delegation (signCertificate)
import Cardano.Chain.Genesis (GenesisHash (..))
import Cardano.Chain.Slotting (
  EpochNumber (..),
  EpochSlots,
  WithEpochSlots (WithEpochSlots),
 )
import Cardano.Chain.Ssc (SscPayload (..), SscProof (..))
import Cardano.Crypto (
  ProtocolMagicId,
  SignTag (SignBlock),
  noPassSafeSigner,
  safeToVerification,
  sign,
  toVerification,
 )
import Cardano.Prelude
import Data.Coerce (coerce)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (
  genChainDifficulty,
 )
import qualified Test.Cardano.Chain.Delegation.Gen as Delegation
import Test.Cardano.Chain.Slotting.Gen (
  genEpochAndSlotCount,
  genEpochNumber,
  genEpochSlots,
  genSlotNumber,
 )
import Test.Cardano.Chain.UTxO.Gen (genTxPayload, genTxProof)
import qualified Test.Cardano.Chain.Update.Gen as Update
import Test.Cardano.Crypto.Gen (
  genAbstractHash,
  genSafeSigner,
  genSigningKey,
  genTextHash,
 )

genBlockSignature :: ProtocolMagicId -> EpochSlots -> Gen BlockSignature
genBlockSignature :: ProtocolMagicId -> EpochSlots -> Gen BlockSignature
genBlockSignature ProtocolMagicId
pm EpochSlots
epochSlots =
  SafeSigner -> SigningKey -> EpochNumber -> ToSign -> BlockSignature
mkBlockSignature
    (SafeSigner
 -> SigningKey -> EpochNumber -> ToSign -> BlockSignature)
-> GenT Identity SafeSigner
-> GenT
     Identity (SigningKey -> EpochNumber -> ToSign -> BlockSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity SafeSigner
genSafeSigner
    GenT
  Identity (SigningKey -> EpochNumber -> ToSign -> BlockSignature)
-> GenT Identity SigningKey
-> GenT Identity (EpochNumber -> ToSign -> BlockSignature)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SigningKey
genSigningKey
    GenT Identity (EpochNumber -> ToSign -> BlockSignature)
-> GenT Identity EpochNumber
-> GenT Identity (ToSign -> BlockSignature)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber
genEpochNumber
    GenT Identity (ToSign -> BlockSignature)
-> GenT Identity ToSign -> Gen BlockSignature
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> EpochSlots -> GenT Identity ToSign
genToSign ProtocolMagicId
pm EpochSlots
epochSlots
  where
    mkBlockSignature :: SafeSigner -> SigningKey -> EpochNumber -> ToSign -> BlockSignature
mkBlockSignature SafeSigner
issuerSafeSigner SigningKey
delegateSK EpochNumber
epoch ToSign
toSign =
      let cert :: Certificate
cert =
            ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
pm (SigningKey -> VerificationKey
toVerification SigningKey
delegateSK) EpochNumber
epoch SafeSigner
issuerSafeSigner
          issuerVK :: VerificationKey
issuerVK = SafeSigner -> VerificationKey
safeToVerification SafeSigner
issuerSafeSigner
          sig :: Signature ToSign
sig = ProtocolMagicId
-> SignTag -> SigningKey -> ToSign -> Signature ToSign
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm (VerificationKey -> SignTag
SignBlock VerificationKey
issuerVK) SigningKey
delegateSK ToSign
toSign
       in Certificate -> Signature ToSign -> BlockSignature
forall a. ACertificate a -> Signature ToSign -> ABlockSignature a
ABlockSignature Certificate
cert Signature ToSign
sig

genHeaderHash :: Gen HeaderHash
genHeaderHash :: Gen HeaderHash
genHeaderHash = Hash Text -> HeaderHash
forall a b. Coercible a b => a -> b
coerce (Hash Text -> HeaderHash)
-> GenT Identity (Hash Text) -> Gen HeaderHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Hash Text)
genTextHash

genBody :: ProtocolMagicId -> Gen Body
genBody :: ProtocolMagicId -> Gen Body
genBody ProtocolMagicId
pm =
  TxPayload -> SscPayload -> Payload -> Payload -> Body
Body
    (TxPayload -> SscPayload -> Payload -> Payload -> Body)
-> GenT Identity TxPayload
-> GenT Identity (SscPayload -> Payload -> Payload -> Body)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> GenT Identity TxPayload
genTxPayload ProtocolMagicId
pm
    GenT Identity (SscPayload -> Payload -> Payload -> Body)
-> GenT Identity SscPayload
-> GenT Identity (Payload -> Payload -> Body)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SscPayload -> GenT Identity SscPayload
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscPayload
SscPayload
    GenT Identity (Payload -> Payload -> Body)
-> GenT Identity Payload -> GenT Identity (Payload -> Body)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> GenT Identity Payload
Delegation.genPayload ProtocolMagicId
pm
    GenT Identity (Payload -> Body)
-> GenT Identity Payload -> Gen Body
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> GenT Identity Payload
Update.genPayload ProtocolMagicId
pm

genHeader :: ProtocolMagicId -> EpochSlots -> Gen Header
genHeader :: ProtocolMagicId -> EpochSlots -> Gen Header
genHeader ProtocolMagicId
protocolMagicId EpochSlots
epochSlots =
  HeaderHash
-> ChainDifficulty
-> SlotNumber
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> SigningKey
-> Header
mkHeaderExplicit'
    (HeaderHash
 -> ChainDifficulty
 -> SlotNumber
 -> Body
 -> ProtocolVersion
 -> SoftwareVersion
 -> SigningKey
 -> Header)
-> Gen HeaderHash
-> GenT
     Identity
     (ChainDifficulty
      -> SlotNumber
      -> Body
      -> ProtocolVersion
      -> SoftwareVersion
      -> SigningKey
      -> Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen HeaderHash
genHeaderHash
    GenT
  Identity
  (ChainDifficulty
   -> SlotNumber
   -> Body
   -> ProtocolVersion
   -> SoftwareVersion
   -> SigningKey
   -> Header)
-> GenT Identity ChainDifficulty
-> GenT
     Identity
     (SlotNumber
      -> Body
      -> ProtocolVersion
      -> SoftwareVersion
      -> SigningKey
      -> Header)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ChainDifficulty
genChainDifficulty
    GenT
  Identity
  (SlotNumber
   -> Body
   -> ProtocolVersion
   -> SoftwareVersion
   -> SigningKey
   -> Header)
-> GenT Identity SlotNumber
-> GenT
     Identity
     (Body
      -> ProtocolVersion -> SoftwareVersion -> SigningKey -> Header)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotNumber
genSlotNumber
    GenT
  Identity
  (Body
   -> ProtocolVersion -> SoftwareVersion -> SigningKey -> Header)
-> Gen Body
-> GenT
     Identity
     (ProtocolVersion -> SoftwareVersion -> SigningKey -> Header)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen Body
genBody ProtocolMagicId
protocolMagicId
    GenT
  Identity
  (ProtocolVersion -> SoftwareVersion -> SigningKey -> Header)
-> GenT Identity ProtocolVersion
-> GenT Identity (SoftwareVersion -> SigningKey -> Header)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ProtocolVersion
Update.genProtocolVersion
    GenT Identity (SoftwareVersion -> SigningKey -> Header)
-> GenT Identity SoftwareVersion
-> GenT Identity (SigningKey -> Header)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftwareVersion
Update.genSoftwareVersion
    GenT Identity (SigningKey -> Header)
-> GenT Identity SigningKey -> Gen Header
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SigningKey
genSigningKey
  where
    mkHeaderExplicit' :: HeaderHash
-> ChainDifficulty
-> SlotNumber
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> SigningKey
-> Header
mkHeaderExplicit'
      HeaderHash
headerHash
      ChainDifficulty
chainDifficulty
      SlotNumber
slotNumber
      Body
body
      ProtocolVersion
protocolVersion
      SoftwareVersion
softwareVersion
      SigningKey
signingKey =
        ProtocolMagicId
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> Header
mkHeaderExplicit
          ProtocolMagicId
protocolMagicId
          HeaderHash
headerHash
          ChainDifficulty
chainDifficulty
          EpochSlots
epochSlots
          SlotNumber
slotNumber
          SigningKey
signingKey
          ( ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate
              ProtocolMagicId
protocolMagicId
              (SigningKey -> VerificationKey
toVerification SigningKey
signingKey)
              (Word64 -> EpochNumber
EpochNumber Word64
0)
              (SigningKey -> SafeSigner
noPassSafeSigner SigningKey
signingKey)
          )
          Body
body
          ProtocolVersion
protocolVersion
          SoftwareVersion
softwareVersion

genProof :: ProtocolMagicId -> Gen Proof
genProof :: ProtocolMagicId -> Gen Proof
genProof ProtocolMagicId
pm =
  TxProof -> SscProof -> Hash Payload -> Proof -> Proof
Proof
    (TxProof -> SscProof -> Hash Payload -> Proof -> Proof)
-> GenT Identity TxProof
-> GenT Identity (SscProof -> Hash Payload -> Proof -> Proof)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> GenT Identity TxProof
genTxProof ProtocolMagicId
pm
    GenT Identity (SscProof -> Hash Payload -> Proof -> Proof)
-> GenT Identity SscProof
-> GenT Identity (Hash Payload -> Proof -> Proof)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SscProof -> GenT Identity SscProof
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscProof
SscProof
    GenT Identity (Hash Payload -> Proof -> Proof)
-> GenT Identity (Hash Payload) -> GenT Identity (Proof -> Proof)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Payload -> GenT Identity (Hash Payload)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash (ProtocolMagicId -> GenT Identity Payload
Delegation.genPayload ProtocolMagicId
pm)
    GenT Identity (Proof -> Proof) -> GenT Identity Proof -> Gen Proof
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> GenT Identity Proof
Update.genProof ProtocolMagicId
pm

genToSign :: ProtocolMagicId -> EpochSlots -> Gen ToSign
genToSign :: ProtocolMagicId -> EpochSlots -> GenT Identity ToSign
genToSign ProtocolMagicId
pm EpochSlots
epochSlots =
  HeaderHash
-> Proof
-> EpochAndSlotCount
-> ChainDifficulty
-> ProtocolVersion
-> SoftwareVersion
-> ToSign
ToSign
    (HeaderHash
 -> Proof
 -> EpochAndSlotCount
 -> ChainDifficulty
 -> ProtocolVersion
 -> SoftwareVersion
 -> ToSign)
-> Gen HeaderHash
-> GenT
     Identity
     (Proof
      -> EpochAndSlotCount
      -> ChainDifficulty
      -> ProtocolVersion
      -> SoftwareVersion
      -> ToSign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Header -> HeaderHash
mkAbstractHash (Header -> HeaderHash) -> Gen Header -> Gen HeaderHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> EpochSlots -> Gen Header
genHeader ProtocolMagicId
pm EpochSlots
epochSlots)
    GenT
  Identity
  (Proof
   -> EpochAndSlotCount
   -> ChainDifficulty
   -> ProtocolVersion
   -> SoftwareVersion
   -> ToSign)
-> Gen Proof
-> GenT
     Identity
     (EpochAndSlotCount
      -> ChainDifficulty -> ProtocolVersion -> SoftwareVersion -> ToSign)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen Proof
genProof ProtocolMagicId
pm
    GenT
  Identity
  (EpochAndSlotCount
   -> ChainDifficulty -> ProtocolVersion -> SoftwareVersion -> ToSign)
-> GenT Identity EpochAndSlotCount
-> GenT
     Identity
     (ChainDifficulty -> ProtocolVersion -> SoftwareVersion -> ToSign)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochSlots -> GenT Identity EpochAndSlotCount
genEpochAndSlotCount EpochSlots
epochSlots
    GenT
  Identity
  (ChainDifficulty -> ProtocolVersion -> SoftwareVersion -> ToSign)
-> GenT Identity ChainDifficulty
-> GenT Identity (ProtocolVersion -> SoftwareVersion -> ToSign)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ChainDifficulty
genChainDifficulty
    GenT Identity (ProtocolVersion -> SoftwareVersion -> ToSign)
-> GenT Identity ProtocolVersion
-> GenT Identity (SoftwareVersion -> ToSign)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ProtocolVersion
Update.genProtocolVersion
    GenT Identity (SoftwareVersion -> ToSign)
-> GenT Identity SoftwareVersion -> GenT Identity ToSign
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftwareVersion
Update.genSoftwareVersion
  where
    mkAbstractHash :: Header -> HeaderHash
    mkAbstractHash :: Header -> HeaderHash
mkAbstractHash = EpochSlots -> Header -> HeaderHash
hashHeader EpochSlots
epochSlots

genBlockWithEpochSlots :: ProtocolMagicId -> Gen (WithEpochSlots Block)
genBlockWithEpochSlots :: ProtocolMagicId -> Gen (WithEpochSlots Block)
genBlockWithEpochSlots ProtocolMagicId
pm = do
  EpochSlots
epochSlots <- Gen EpochSlots
genEpochSlots
  EpochSlots -> Block -> WithEpochSlots Block
forall a. EpochSlots -> a -> WithEpochSlots a
WithEpochSlots EpochSlots
epochSlots (Block -> WithEpochSlots Block)
-> GenT Identity Block -> Gen (WithEpochSlots Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> EpochSlots -> GenT Identity Block
genBlock ProtocolMagicId
pm EpochSlots
epochSlots

genBlock :: ProtocolMagicId -> EpochSlots -> Gen Block
genBlock :: ProtocolMagicId -> EpochSlots -> GenT Identity Block
genBlock ProtocolMagicId
protocolMagicId EpochSlots
epochSlots =
  ProtocolVersion
-> SoftwareVersion
-> HeaderHash
-> ChainDifficulty
-> SlotNumber
-> Body
-> SigningKey
-> Block
mkBlockExplicit'
    (ProtocolVersion
 -> SoftwareVersion
 -> HeaderHash
 -> ChainDifficulty
 -> SlotNumber
 -> Body
 -> SigningKey
 -> Block)
-> GenT Identity ProtocolVersion
-> GenT
     Identity
     (SoftwareVersion
      -> HeaderHash
      -> ChainDifficulty
      -> SlotNumber
      -> Body
      -> SigningKey
      -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ProtocolVersion
Update.genProtocolVersion
    GenT
  Identity
  (SoftwareVersion
   -> HeaderHash
   -> ChainDifficulty
   -> SlotNumber
   -> Body
   -> SigningKey
   -> Block)
-> GenT Identity SoftwareVersion
-> GenT
     Identity
     (HeaderHash
      -> ChainDifficulty -> SlotNumber -> Body -> SigningKey -> Block)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SoftwareVersion
Update.genSoftwareVersion
    GenT
  Identity
  (HeaderHash
   -> ChainDifficulty -> SlotNumber -> Body -> SigningKey -> Block)
-> Gen HeaderHash
-> GenT
     Identity
     (ChainDifficulty -> SlotNumber -> Body -> SigningKey -> Block)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen HeaderHash
genHeaderHash
    GenT
  Identity
  (ChainDifficulty -> SlotNumber -> Body -> SigningKey -> Block)
-> GenT Identity ChainDifficulty
-> GenT Identity (SlotNumber -> Body -> SigningKey -> Block)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ChainDifficulty
genChainDifficulty
    GenT Identity (SlotNumber -> Body -> SigningKey -> Block)
-> GenT Identity SlotNumber
-> GenT Identity (Body -> SigningKey -> Block)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotNumber
genSlotNumber
    GenT Identity (Body -> SigningKey -> Block)
-> Gen Body -> GenT Identity (SigningKey -> Block)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen Body
genBody ProtocolMagicId
protocolMagicId
    GenT Identity (SigningKey -> Block)
-> GenT Identity SigningKey -> GenT Identity Block
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SigningKey
genSigningKey
  where
    mkBlockExplicit' :: ProtocolVersion
-> SoftwareVersion
-> HeaderHash
-> ChainDifficulty
-> SlotNumber
-> Body
-> SigningKey
-> Block
mkBlockExplicit'
      ProtocolVersion
protocolVersion
      SoftwareVersion
softwareVersion
      HeaderHash
headerHash
      ChainDifficulty
chainDifficulty
      SlotNumber
slotNumber
      Body
body
      SigningKey
signingKey =
        ProtocolMagicId
-> ProtocolVersion
-> SoftwareVersion
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> Block
mkBlockExplicit
          ProtocolMagicId
protocolMagicId
          ProtocolVersion
protocolVersion
          SoftwareVersion
softwareVersion
          HeaderHash
headerHash
          ChainDifficulty
chainDifficulty
          EpochSlots
epochSlots
          SlotNumber
slotNumber
          SigningKey
signingKey
          ( ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate
              ProtocolMagicId
protocolMagicId
              (SigningKey -> VerificationKey
toVerification SigningKey
signingKey)
              (Word64 -> EpochNumber
EpochNumber Word64
0)
              (SigningKey -> SafeSigner
noPassSafeSigner SigningKey
signingKey)
          )
          Body
body

genBoundaryBlock :: Gen (ABoundaryBlock ())
genBoundaryBlock :: Gen (ABoundaryBlock ())
genBoundaryBlock =
  Int64
-> ABoundaryHeader ()
-> ABoundaryBody ()
-> ()
-> ABoundaryBlock ()
forall a.
Int64
-> ABoundaryHeader a -> ABoundaryBody a -> a -> ABoundaryBlock a
ABoundaryBlock
    (Int64
 -> ABoundaryHeader ()
 -> ABoundaryBody ()
 -> ()
 -> ABoundaryBlock ())
-> GenT Identity Int64
-> GenT
     Identity
     (ABoundaryHeader () -> ABoundaryBody () -> () -> ABoundaryBlock ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> GenT Identity Int64
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
    GenT
  Identity
  (ABoundaryHeader () -> ABoundaryBody () -> () -> ABoundaryBlock ())
-> GenT Identity (ABoundaryHeader ())
-> GenT Identity (ABoundaryBody () -> () -> ABoundaryBlock ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity (ABoundaryHeader ())
genBoundaryHeader
    GenT Identity (ABoundaryBody () -> () -> ABoundaryBlock ())
-> GenT Identity (ABoundaryBody ())
-> GenT Identity (() -> ABoundaryBlock ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ABoundaryBody () -> GenT Identity (ABoundaryBody ())
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ABoundaryBody ()
forall a. a -> ABoundaryBody a
ABoundaryBody ())
    GenT Identity (() -> ABoundaryBlock ())
-> GenT Identity () -> Gen (ABoundaryBlock ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> GenT Identity ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

genBoundaryHeader :: Gen (ABoundaryHeader ())
genBoundaryHeader :: GenT Identity (ABoundaryHeader ())
genBoundaryHeader = do
  Word64
epoch <- Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.exponential Word64
0 Word64
forall a. Bounded a => a
maxBound)
  Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> () -> ABoundaryHeader ()
forall a.
Either GenesisHash HeaderHash
-> Word64 -> ChainDifficulty -> a -> ABoundaryHeader a
mkABoundaryHeader
    (Either GenesisHash HeaderHash
 -> Word64 -> ChainDifficulty -> () -> ABoundaryHeader ())
-> GenT Identity (Either GenesisHash HeaderHash)
-> GenT
     Identity (Word64 -> ChainDifficulty -> () -> ABoundaryHeader ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( if Word64
epoch Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then GenesisHash -> Either GenesisHash HeaderHash
forall a b. a -> Either a b
Left (GenesisHash -> Either GenesisHash HeaderHash)
-> (Hash Text -> GenesisHash)
-> Hash Text
-> Either GenesisHash HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AbstractHash Blake2b_256 Raw -> GenesisHash
GenesisHash (AbstractHash Blake2b_256 Raw -> GenesisHash)
-> (Hash Text -> AbstractHash Blake2b_256 Raw)
-> Hash Text
-> GenesisHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash Text -> AbstractHash Blake2b_256 Raw
forall a b. Coercible a b => a -> b
coerce (Hash Text -> Either GenesisHash HeaderHash)
-> GenT Identity (Hash Text)
-> GenT Identity (Either GenesisHash HeaderHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Hash Text)
genTextHash
            else
              [GenT Identity (Either GenesisHash HeaderHash)]
-> GenT Identity (Either GenesisHash HeaderHash)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
                [ HeaderHash -> Either GenesisHash HeaderHash
forall a b. b -> Either a b
Right (HeaderHash -> Either GenesisHash HeaderHash)
-> Gen HeaderHash -> GenT Identity (Either GenesisHash HeaderHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen HeaderHash
genHeaderHash
                , GenesisHash -> Either GenesisHash HeaderHash
forall a b. a -> Either a b
Left (GenesisHash -> Either GenesisHash HeaderHash)
-> (Hash Text -> GenesisHash)
-> Hash Text
-> Either GenesisHash HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AbstractHash Blake2b_256 Raw -> GenesisHash
GenesisHash (AbstractHash Blake2b_256 Raw -> GenesisHash)
-> (Hash Text -> AbstractHash Blake2b_256 Raw)
-> Hash Text
-> GenesisHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash Text -> AbstractHash Blake2b_256 Raw
forall a b. Coercible a b => a -> b
coerce (Hash Text -> Either GenesisHash HeaderHash)
-> GenT Identity (Hash Text)
-> GenT Identity (Either GenesisHash HeaderHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Hash Text)
genTextHash
                ]
        )
    GenT
  Identity (Word64 -> ChainDifficulty -> () -> ABoundaryHeader ())
-> GenT Identity Word64
-> GenT Identity (ChainDifficulty -> () -> ABoundaryHeader ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word64 -> GenT Identity Word64
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
epoch
    GenT Identity (ChainDifficulty -> () -> ABoundaryHeader ())
-> GenT Identity ChainDifficulty
-> GenT Identity (() -> ABoundaryHeader ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ChainDifficulty
genChainDifficulty
    GenT Identity (() -> ABoundaryHeader ())
-> GenT Identity () -> GenT Identity (ABoundaryHeader ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> GenT Identity ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

genABlockOrBoundaryHdr ::
  ProtocolMagicId ->
  EpochSlots ->
  Gen (ABlockOrBoundaryHdr ByteString)
genABlockOrBoundaryHdr :: ProtocolMagicId
-> EpochSlots -> Gen (ABlockOrBoundaryHdr ByteString)
genABlockOrBoundaryHdr ProtocolMagicId
pm EpochSlots
es =
  [Gen (ABlockOrBoundaryHdr ByteString)]
-> Gen (ABlockOrBoundaryHdr ByteString)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ AHeader ByteString -> ABlockOrBoundaryHdr ByteString
forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr (AHeader ByteString -> ABlockOrBoundaryHdr ByteString)
-> (Header -> AHeader ByteString)
-> Header
-> ABlockOrBoundaryHdr ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Header -> AHeader ByteString
reAnnotateHdr (Header -> ABlockOrBoundaryHdr ByteString)
-> Gen Header -> Gen (ABlockOrBoundaryHdr ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> EpochSlots -> Gen Header
genHeader ProtocolMagicId
pm EpochSlots
es
    , ABoundaryHeader ByteString -> ABlockOrBoundaryHdr ByteString
forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr (ABoundaryHeader ByteString -> ABlockOrBoundaryHdr ByteString)
-> (ABoundaryHeader () -> ABoundaryHeader ByteString)
-> ABoundaryHeader ()
-> ABlockOrBoundaryHdr ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABoundaryHeader () -> ABoundaryHeader ByteString
reAnnotateBoundaryHdr (ABoundaryHeader () -> ABlockOrBoundaryHdr ByteString)
-> GenT Identity (ABoundaryHeader ())
-> Gen (ABlockOrBoundaryHdr ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (ABoundaryHeader ())
genBoundaryHeader
    ]
  where
    reAnnotateHdr :: AHeader () -> AHeader ByteString
    reAnnotateHdr :: Header -> AHeader ByteString
reAnnotateHdr =
      (Header -> Encoding)
-> (forall s. Decoder s (AHeader ByteSpan))
-> Header
-> AHeader ByteString
forall (f :: * -> *) a.
Functor f =>
(f a -> Encoding)
-> (forall s. Decoder s (f ByteSpan)) -> f a -> f ByteString
reAnnotateUsing
        (EpochSlots -> Header -> Encoding
encCBORHeader EpochSlots
es)
        (EpochSlots -> Decoder s (AHeader ByteSpan)
forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
es)

    reAnnotateBoundaryHdr :: ABoundaryHeader () -> ABoundaryHeader ByteString
    reAnnotateBoundaryHdr :: ABoundaryHeader () -> ABoundaryHeader ByteString
reAnnotateBoundaryHdr =
      (ABoundaryHeader () -> Encoding)
-> (forall s. Decoder s (ABoundaryHeader ByteSpan))
-> ABoundaryHeader ()
-> ABoundaryHeader ByteString
forall (f :: * -> *) a.
Functor f =>
(f a -> Encoding)
-> (forall s. Decoder s (f ByteSpan)) -> f a -> f ByteString
reAnnotateUsing
        (ProtocolMagicId -> ABoundaryHeader () -> Encoding
forall a. ProtocolMagicId -> ABoundaryHeader a -> Encoding
encCBORABoundaryHeader ProtocolMagicId
pm)
        Decoder s (ABoundaryHeader ByteSpan)
forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader