{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Protocol.TPraos.Create (
  AllIssuerKeys (..),
  KESKeyPair (..),
  VRFKeyPair (..),
  mkOCert,
  mkBHBody,
  mkBHBodyFakeVRF,
  mkBHeader,
  mkBlock,
  mkBlockFakeVRF,
  evolveKESUntil,
) where

import qualified Cardano.Crypto.KES.Class as KES
import qualified Cardano.Crypto.VRF.Class as VRF
import Cardano.Ledger.BaseTypes (
  BlockNo,
  Nonce,
  ProtVer (..),
  Seed,
  SlotNo,
  UnitInterval,
  unboundRational,
 )
import Cardano.Ledger.Block
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (HasKeyRole (coerceKeyRole), signedDSIGN)
import Cardano.Protocol.Crypto
import Cardano.Protocol.TPraos.BHeader (
  BHBody (..),
  BHeader (..),
  HashHeader,
  PrevHash (BlockHash),
  mkSeed,
  seedEta,
  seedL,
 )
import Cardano.Protocol.TPraos.OCert (
  KESPeriod (..),
  OCert (..),
  OCertSignable (..),
 )
import Data.Coerce
import Data.List.NonEmpty as NE
import Data.Ratio (denominator, numerator, (%))
import Data.Sequence.Strict as StrictSeq
import Data.Word
import Numeric.Natural
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Protocol.Crypto.KES (KESKeyPair (..))
import Test.Cardano.Protocol.Crypto.VRF (VRFKeyPair (..))
import Test.Cardano.Protocol.Crypto.VRF.Fake (NatNonce (..), WithResult (..))

data AllIssuerKeys c (r :: KeyRole) = AllIssuerKeys
  { forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold :: KeyPair r
  , forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf :: VRFKeyPair c
  , forall c (r :: KeyRole).
AllIssuerKeys c r -> NonEmpty (KESPeriod, KESKeyPair c)
aikHot :: NonEmpty (KESPeriod, KESKeyPair c)
  , forall c (r :: KeyRole). AllIssuerKeys c r -> KeyHash r
aikColdKeyHash :: KeyHash r
  }

deriving instance
  (Show (VRF.SignKeyVRF (VRF c)), Show (VRF.VerKeyVRF (VRF c)), Show (KES.VerKeyKES (KES c))) =>
  Show (AllIssuerKeys c r)

mkOCert ::
  forall c r.
  Crypto c =>
  AllIssuerKeys c r ->
  Word64 ->
  KESPeriod ->
  OCert c
mkOCert :: forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys c r
pKeys Word64
kesPeriod KESPeriod
keyRegKesPeriod =
  let vKeyHot :: VerKeyKES (KES c)
vKeyHot = forall c. KESKeyPair c -> VerKeyKES (KES c)
kesVerKey forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole).
AllIssuerKeys c r -> NonEmpty (KESPeriod, KESKeyPair c)
aikHot AllIssuerKeys c r
pKeys
      sKeyCold :: SignKeyDSIGN DSIGN
sKeyCold = forall (kd :: KeyRole). KeyPair kd -> SignKeyDSIGN DSIGN
sKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys c r
pKeys
   in OCert
        { ocertVkHot :: VerKeyKES (KES c)
ocertVkHot = VerKeyKES (KES c)
vKeyHot
        , ocertN :: Word64
ocertN = Word64
kesPeriod
        , ocertKESPeriod :: KESPeriod
ocertKESPeriod = KESPeriod
keyRegKesPeriod
        , ocertSigma :: SignedDSIGN DSIGN (OCertSignable c)
ocertSigma = forall a.
Signable DSIGN a =>
SignKeyDSIGN DSIGN -> a -> SignedDSIGN DSIGN a
signedDSIGN SignKeyDSIGN DSIGN
sKeyCold (forall c.
VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
OCertSignable VerKeyKES (KES c)
vKeyHot Word64
kesPeriod KESPeriod
keyRegKesPeriod)
        }

mkBHBody ::
  ( VRF.ContextVRF (VRF c) ~ ()
  , VRF.Signable (VRF c) Seed
  , VRF.VRFAlgorithm (VRF c)
  ) =>
  ProtVer ->
  HashHeader ->
  AllIssuerKeys c r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert c ->
  Word32 ->
  Hash HASH EraIndependentBlockBody ->
  BHBody c
mkBHBody :: 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 = forall a c b (r :: KeyRole).
(Coercible a (CertifiedVRF (VRF c) Nonce),
 Coercible b (CertifiedVRF (VRF c) Natural)) =>
(Seed -> SignKeyVRF (VRF c) -> a)
-> (Seed -> SignKeyVRF (VRF c) -> b)
-> ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBodyWithVRF (forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified ()) (forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified ())

mkBHBodyFakeVRF ::
  ( VRF.ContextVRF (VRF c) ~ ()
  , VRF.Signable (VRF c) (WithResult Seed)
  , VRF.VRFAlgorithm (VRF c)
  ) =>
  NatNonce ->
  UnitInterval ->
  ProtVer ->
  HashHeader ->
  AllIssuerKeys c r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert c ->
  Word32 ->
  Hash HASH EraIndependentBlockBody ->
  BHBody c
mkBHBodyFakeVRF :: forall c (r :: KeyRole).
(ContextVRF (VRF c) ~ (), Signable (VRF c) (WithResult Seed),
 VRFAlgorithm (VRF c)) =>
NatNonce
-> UnitInterval
-> ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBodyFakeVRF (NatNonce Natural
bnonce) UnitInterval
l =
  forall a c b (r :: KeyRole).
(Coercible a (CertifiedVRF (VRF c) Nonce),
 Coercible b (CertifiedVRF (VRF c) Natural)) =>
(Seed -> SignKeyVRF (VRF c) -> a)
-> (Seed -> SignKeyVRF (VRF c) -> b)
-> ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBodyWithVRF
    (\Seed
nonce -> forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () (forall a. a -> Word64 -> WithResult a
WithResult Seed
nonce (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
bnonce)))
    (\Seed
nonce -> forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () (forall a. a -> Word64 -> WithResult a
WithResult Seed
nonce (UnitInterval -> Word64
unitIntervalToWord64 UnitInterval
l)))

-- | Try to map the unit interval to a 64bit natural number. We don't care whether
-- this is surjective. But it should be right inverse to `fromNatural` - that
-- is, one should be able to recover the `UnitInterval` value used here.
unitIntervalToWord64 :: UnitInterval -> Word64
unitIntervalToWord64 :: UnitInterval -> Word64
unitIntervalToWord64 UnitInterval
ui =
  forall {a}. Num a => Ratio Integer -> a
toWord64 ((forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word64) forall a. Integral a => a -> a -> Ratio a
% Integer
1) forall a. Num a => a -> a -> a
* forall r. BoundedRational r => r -> Ratio Integer
unboundRational UnitInterval
ui)
  where
    toWord64 :: Ratio Integer -> a
toWord64 Ratio Integer
r = forall a. Num a => Integer -> a
fromInteger (forall a. Ratio a -> a
numerator Ratio Integer
r forall a. Integral a => a -> a -> a
`quot` forall a. Ratio a -> a
denominator Ratio Integer
r)

mkBHBodyWithVRF ::
  ( Coercible a (VRF.CertifiedVRF (VRF c) Nonce)
  , Coercible b (VRF.CertifiedVRF (VRF c) Natural)
  ) =>
  (Seed -> VRF.SignKeyVRF (VRF c) -> a) ->
  (Seed -> VRF.SignKeyVRF (VRF c) -> b) ->
  ProtVer ->
  HashHeader ->
  AllIssuerKeys c r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert c ->
  Word32 ->
  Hash HASH EraIndependentBlockBody ->
  BHBody c
mkBHBodyWithVRF :: forall a c b (r :: KeyRole).
(Coercible a (CertifiedVRF (VRF c) Nonce),
 Coercible b (CertifiedVRF (VRF c) Natural)) =>
(Seed -> SignKeyVRF (VRF c) -> a)
-> (Seed -> SignKeyVRF (VRF c) -> b)
-> ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBodyWithVRF Seed -> SignKeyVRF (VRF c) -> a
mkVrfEta Seed -> SignKeyVRF (VRF c) -> b
mkVrfL ProtVer
protVer HashHeader
prev AllIssuerKeys c r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert c
oCert Word32
bodySize Hash HASH EraIndependentBlockBody
bodyHash =
  let nonceNonce :: Seed
nonceNonce = Nonce -> SlotNo -> Nonce -> Seed
mkSeed Nonce
seedEta SlotNo
slotNo Nonce
enonce
      leaderNonce :: Seed
leaderNonce = Nonce -> SlotNo -> Nonce -> Seed
mkSeed Nonce
seedL SlotNo
slotNo Nonce
enonce
      vKeyCold :: VKey r
vKeyCold = forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys c r
pKeys
   in BHBody
        { bheaderBlockNo :: BlockNo
bheaderBlockNo = BlockNo
blockNo
        , bheaderSlotNo :: SlotNo
bheaderSlotNo = SlotNo
slotNo
        , bheaderPrev :: PrevHash
bheaderPrev = HashHeader -> PrevHash
BlockHash HashHeader
prev
        , bheaderVk :: VKey 'BlockIssuer
bheaderVk = forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole VKey r
vKeyCold
        , bheaderVrfVk :: VerKeyVRF (VRF c)
bheaderVrfVk = forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys c r
pKeys
        , bheaderEta :: CertifiedVRF (VRF c) Nonce
bheaderEta = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ Seed -> SignKeyVRF (VRF c) -> a
mkVrfEta Seed
nonceNonce (forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys c r
pKeys)
        , bheaderL :: CertifiedVRF (VRF c) Natural
bheaderL = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ Seed -> SignKeyVRF (VRF c) -> b
mkVrfL Seed
leaderNonce (forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys c r
pKeys)
        , bsize :: Word32
bsize = Word32
bodySize
        , bhash :: Hash HASH EraIndependentBlockBody
bhash = Hash HASH EraIndependentBlockBody
bodyHash
        , bheaderOCert :: OCert c
bheaderOCert = OCert c
oCert
        , bprotver :: ProtVer
bprotver = ProtVer
protVer
        }

mkBHeader ::
  (Crypto c, KES.Signable (KES c) (BHBody c)) =>
  AllIssuerKeys c r ->
  Word ->
  -- | KES period of key registration
  Word ->
  BHBody c ->
  BHeader c
mkBHeader :: forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys c r
pKeys Word
kesPeriod Word
keyRegKesPeriod BHBody c
bhBody =
  let sHot :: UnsoundPureSignKeyKES (KES c)
sHot = forall c. KESKeyPair c -> UnsoundPureSignKeyKES (KES c)
kesSignKey forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole).
AllIssuerKeys c r -> NonEmpty (KESPeriod, KESKeyPair c)
aikHot AllIssuerKeys c r
pKeys
      kpDiff :: Word
kpDiff = Word
kesPeriod forall a. Num a => a -> a -> a
- Word
keyRegKesPeriod
      hotKey :: UnsoundPureSignKeyKES (KES c)
hotKey = case forall c.
(UnsoundPureKESAlgorithm c, ContextKES c ~ ()) =>
UnsoundPureSignKeyKES c
-> KESPeriod -> KESPeriod -> Maybe (UnsoundPureSignKeyKES c)
evolveKESUntil UnsoundPureSignKeyKES (KES c)
sHot (Word -> KESPeriod
KESPeriod Word
0) (Word -> KESPeriod
KESPeriod Word
kpDiff) of
        Maybe (UnsoundPureSignKeyKES (KES c))
Nothing ->
          forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
            forall a. Monoid a => [a] -> a
mconcat
              [ String
"Could not evolve key to iteration. "
              , String
"keyRegKesPeriod: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
keyRegKesPeriod
              , String
"kesPeriod: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
kesPeriod
              , String
"kpDiff: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
kpDiff
              ]
        Just UnsoundPureSignKeyKES (KES c)
hKey -> UnsoundPureSignKeyKES (KES c)
hKey
      sig :: SignedKES (KES c) (BHBody c)
sig = forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
KES.unsoundPureSignedKES () Word
kpDiff BHBody c
bhBody UnsoundPureSignKeyKES (KES c)
hotKey
   in forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
BHeader BHBody c
bhBody SignedKES (KES c) (BHBody c)
sig

-- | Try to evolve KES key until specific KES period is reached, given the
-- current KES period.
evolveKESUntil ::
  (KES.UnsoundPureKESAlgorithm c, KES.ContextKES c ~ ()) =>
  KES.UnsoundPureSignKeyKES c ->
  -- | Current KES period
  KESPeriod ->
  -- | Target KES period
  KESPeriod ->
  Maybe (KES.UnsoundPureSignKeyKES c)
evolveKESUntil :: forall c.
(UnsoundPureKESAlgorithm c, ContextKES c ~ ()) =>
UnsoundPureSignKeyKES c
-> KESPeriod -> KESPeriod -> Maybe (UnsoundPureSignKeyKES c)
evolveKESUntil UnsoundPureSignKeyKES c
sk1 (KESPeriod Word
current) (KESPeriod Word
target) = forall {v}.
(ContextKES v ~ (), UnsoundPureKESAlgorithm v) =>
UnsoundPureSignKeyKES v
-> Word -> Word -> Maybe (UnsoundPureSignKeyKES v)
go UnsoundPureSignKeyKES c
sk1 Word
current Word
target
  where
    go :: UnsoundPureSignKeyKES v
-> Word -> Word -> Maybe (UnsoundPureSignKeyKES v)
go !UnsoundPureSignKeyKES v
_ Word
c Word
t | Word
t forall a. Ord a => a -> a -> Bool
< Word
c = forall a. Maybe a
Nothing
    go !UnsoundPureSignKeyKES v
sk Word
c Word
t | Word
c forall a. Eq a => a -> a -> Bool
== Word
t = forall a. a -> Maybe a
Just UnsoundPureSignKeyKES v
sk
    go !UnsoundPureSignKeyKES v
sk Word
c Word
t = case forall v.
UnsoundPureKESAlgorithm v =>
ContextKES v
-> UnsoundPureSignKeyKES v
-> Word
-> Maybe (UnsoundPureSignKeyKES v)
KES.unsoundPureUpdateKES () UnsoundPureSignKeyKES v
sk Word
c of
      Maybe (UnsoundPureSignKeyKES v)
Nothing -> forall a. Maybe a
Nothing
      Just UnsoundPureSignKeyKES v
sk' -> UnsoundPureSignKeyKES v
-> Word -> Word -> Maybe (UnsoundPureSignKeyKES v)
go UnsoundPureSignKeyKES v
sk' (Word
c forall a. Num a => a -> a -> a
+ Word
1) Word
t

mkBlock ::
  forall era r c.
  ( Crypto c
  , EraSegWits era
  , VRF.Signable (VRF c) Seed
  , KES.Signable (KES c) (BHBody c)
  ) =>
  -- | Hash of previous block
  HashHeader ->
  -- | All keys in the stake pool
  AllIssuerKeys c r ->
  -- | Transactions to record
  [Tx era] ->
  -- | Current slot
  SlotNo ->
  -- | Block number/chain length/chain "difficulty"
  BlockNo ->
  -- | EpochNo nonce
  Nonce ->
  -- | Period of KES (key evolving signature scheme)
  Word ->
  -- | KES period of key registration
  Word ->
  -- | Operational certificate
  OCert c ->
  Block (BHeader c) era
mkBlock :: forall era (r :: KeyRole) c.
(Crypto c, EraSegWits 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
prev AllIssuerKeys c r
pKeys [Tx era]
txns SlotNo
slotNo BlockNo
blockNo Nonce
enonce Word
kesPeriod Word
keyRegKesPeriod OCert c
oCert =
  let protVer :: ProtVer
protVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerHigh @era) Natural
0
      txseq :: TxSeq era
txseq = forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq @era (forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era]
txns)
      bodySize :: Word32
bodySize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall era. EraSegWits era => ProtVer -> TxSeq era -> Int
bBodySize ProtVer
protVer TxSeq era
txseq
      bodyHash :: Hash HASH EraIndependentBlockBody
bodyHash = forall era.
EraSegWits era =>
TxSeq era -> Hash HASH EraIndependentBlockBody
hashTxSeq @era TxSeq era
txseq
      bhBody :: BHBody c
bhBody = 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
prev AllIssuerKeys c r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert c
oCert Word32
bodySize Hash HASH EraIndependentBlockBody
bodyHash
      bHeader :: BHeader c
bHeader = forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys c r
pKeys Word
kesPeriod Word
keyRegKesPeriod BHBody c
bhBody
   in forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader c
bHeader TxSeq era
txseq

-- | Create a block with a faked VRF result.
mkBlockFakeVRF ::
  forall era r c.
  ( Crypto c
  , EraSegWits era
  , VRF.Signable (VRF c) (WithResult Seed)
  , KES.Signable (KES c) (BHBody c)
  ) =>
  -- | Hash of previous block
  HashHeader ->
  -- | All keys in the stake pool
  AllIssuerKeys c r ->
  -- | Transactions to record
  [Tx era] ->
  -- | Current slot
  SlotNo ->
  -- | Block number\/chain length\/chain "difficulty"
  BlockNo ->
  -- | EpochNo nonce
  Nonce ->
  -- | Block nonce
  NatNonce ->
  -- | Praos leader value
  UnitInterval ->
  -- | Period of KES (key evolving signature scheme)
  Word ->
  -- | KES period of key registration
  Word ->
  -- | Operational certificate
  OCert c ->
  Block (BHeader c) era
mkBlockFakeVRF :: forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF HashHeader
prev AllIssuerKeys c r
pKeys [Tx era]
txns SlotNo
slotNo BlockNo
blockNo Nonce
enonce NatNonce
bnonce UnitInterval
l Word
kesPeriod Word
keyRegKesPeriod OCert c
oCert =
  let protVer :: ProtVer
protVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerHigh @era) Natural
0
      txSeq :: TxSeq era
txSeq = forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq @era (forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era]
txns)
      bodySize :: Word32
bodySize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall era. EraSegWits era => ProtVer -> TxSeq era -> Int
bBodySize ProtVer
protVer TxSeq era
txSeq
      bodyHash :: Hash HASH EraIndependentBlockBody
bodyHash = forall era.
EraSegWits era =>
TxSeq era -> Hash HASH EraIndependentBlockBody
hashTxSeq TxSeq era
txSeq
      bhBody :: BHBody c
bhBody =
        forall c (r :: KeyRole).
(ContextVRF (VRF c) ~ (), Signable (VRF c) (WithResult Seed),
 VRFAlgorithm (VRF c)) =>
NatNonce
-> UnitInterval
-> ProtVer
-> HashHeader
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash HASH EraIndependentBlockBody
-> BHBody c
mkBHBodyFakeVRF NatNonce
bnonce UnitInterval
l ProtVer
protVer HashHeader
prev AllIssuerKeys c r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert c
oCert Word32
bodySize Hash HASH EraIndependentBlockBody
bodyHash
      bHeader :: BHeader c
bHeader = forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys c r
pKeys Word
kesPeriod Word
keyRegKesPeriod BHBody c
bhBody
   in forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader c
bHeader TxSeq era
txSeq