{-# 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 Cardano.Crypto.DSIGN (Signable)
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.Crypto
import Cardano.Ledger.Keys (
  HasKeyRole (coerceKeyRole),
  Hash,
  KeyHash,
  KeyRole (..),
  signedDSIGN,
  signedKES,
 )
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 v (r :: KeyRole) = AllIssuerKeys
  { forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold :: KeyPair r v
  , forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf :: VRFKeyPair v
  , forall v (r :: KeyRole).
AllIssuerKeys v r -> NonEmpty (KESPeriod, KESKeyPair v)
aikHot :: NonEmpty (KESPeriod, KESKeyPair v)
  , forall v (r :: KeyRole). AllIssuerKeys v r -> KeyHash r v
aikColdKeyHash :: KeyHash r v
  }
  deriving (Int -> AllIssuerKeys v r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v (r :: KeyRole).
Crypto v =>
Int -> AllIssuerKeys v r -> ShowS
forall v (r :: KeyRole). Crypto v => [AllIssuerKeys v r] -> ShowS
forall v (r :: KeyRole). Crypto v => AllIssuerKeys v r -> String
showList :: [AllIssuerKeys v r] -> ShowS
$cshowList :: forall v (r :: KeyRole). Crypto v => [AllIssuerKeys v r] -> ShowS
show :: AllIssuerKeys v r -> String
$cshow :: forall v (r :: KeyRole). Crypto v => AllIssuerKeys v r -> String
showsPrec :: Int -> AllIssuerKeys v r -> ShowS
$cshowsPrec :: forall v (r :: KeyRole).
Crypto v =>
Int -> AllIssuerKeys v r -> ShowS
Show)

mkOCert ::
  forall c r.
  (Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
  AllIssuerKeys c r ->
  Word64 ->
  KESPeriod ->
  OCert c
mkOCert :: forall c (r :: KeyRole).
(Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys c r
pKeys Word64
kesPeriod KESPeriod
keyRegKesPeriod =
  let vKeyHot :: VerKeyKES c
vKeyHot = forall c. KESKeyPair c -> VerKeyKES 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 v (r :: KeyRole).
AllIssuerKeys v r -> NonEmpty (KESPeriod, KESKeyPair v)
aikHot AllIssuerKeys c r
pKeys
      sKeyCold :: SignKeyDSIGN (DSIGN c)
sKeyCold = forall (kd :: KeyRole) c. KeyPair kd c -> SignKeyDSIGN (DSIGN c)
sKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys c r
pKeys
   in OCert
        { ocertVkHot :: VerKeyKES c
ocertVkHot = VerKeyKES c
vKeyHot
        , ocertN :: Word64
ocertN = Word64
kesPeriod
        , ocertKESPeriod :: KESPeriod
ocertKESPeriod = KESPeriod
keyRegKesPeriod
        , ocertSigma :: SignedDSIGN c (OCertSignable c)
ocertSigma = forall c a.
(Crypto c, Signable (DSIGN c) a) =>
SignKeyDSIGN (DSIGN c) -> a -> SignedDSIGN c a
signedDSIGN @c SignKeyDSIGN (DSIGN c)
sKeyCold (forall c. VerKeyKES c -> Word64 -> KESPeriod -> OCertSignable c
OCertSignable VerKeyKES c
vKeyHot Word64
kesPeriod KESPeriod
keyRegKesPeriod)
        }

mkBHBody ::
  ( VRF.ContextVRF (VRF v) ~ ()
  , VRF.Signable (VRF v) Seed
  , VRF.VRFAlgorithm (VRF v)
  ) =>
  ProtVer ->
  HashHeader v ->
  AllIssuerKeys v r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert v ->
  Word32 ->
  Hash v EraIndependentBlockBody ->
  BHBody v
mkBHBody :: forall v (r :: KeyRole).
(ContextVRF (VRF v) ~ (), Signable (VRF v) Seed,
 VRFAlgorithm (VRF v)) =>
ProtVer
-> HashHeader v
-> AllIssuerKeys v r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert v
-> Word32
-> Hash v EraIndependentBlockBody
-> BHBody v
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 c
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash c 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 v) ~ ()
  , VRF.Signable (VRF v) (WithResult Seed)
  , VRF.VRFAlgorithm (VRF v)
  ) =>
  NatNonce ->
  UnitInterval ->
  ProtVer ->
  HashHeader v ->
  AllIssuerKeys v r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert v ->
  Word32 ->
  Hash v EraIndependentBlockBody ->
  BHBody v
mkBHBodyFakeVRF :: forall v (r :: KeyRole).
(ContextVRF (VRF v) ~ (), Signable (VRF v) (WithResult Seed),
 VRFAlgorithm (VRF v)) =>
NatNonce
-> UnitInterval
-> ProtVer
-> HashHeader v
-> AllIssuerKeys v r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert v
-> Word32
-> Hash v EraIndependentBlockBody
-> BHBody v
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 c
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash c 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 c ->
  AllIssuerKeys c r ->
  SlotNo ->
  BlockNo ->
  Nonce ->
  OCert c ->
  Word32 ->
  Hash c 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 c
-> AllIssuerKeys c r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert c
-> Word32
-> Hash c EraIndependentBlockBody
-> BHBody c
mkBHBodyWithVRF Seed -> SignKeyVRF (VRF c) -> a
mkVrfEta Seed -> SignKeyVRF (VRF c) -> b
mkVrfL ProtVer
protVer HashHeader c
prev AllIssuerKeys c r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert c
oCert Word32
bodySize Hash c 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 c
vKeyCold = forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys c r
pKeys
   in BHBody
        { bheaderBlockNo :: BlockNo
bheaderBlockNo = BlockNo
blockNo
        , bheaderSlotNo :: SlotNo
bheaderSlotNo = SlotNo
slotNo
        , bheaderPrev :: PrevHash c
bheaderPrev = forall c. HashHeader c -> PrevHash c
BlockHash HashHeader c
prev
        , bheaderVk :: VKey 'BlockIssuer c
bheaderVk = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole VKey r c
vKeyCold
        , bheaderVrfVk :: VerKeyVRF c
bheaderVrfVk = forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
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 c
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
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 c
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys c r
pKeys)
        , bsize :: Word32
bsize = Word32
bodySize
        , bhash :: Hash c EraIndependentBlockBody
bhash = Hash c 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 :: SignKeyKES c
sHot = forall c. KESKeyPair c -> SignKeyKES 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 v (r :: KeyRole).
AllIssuerKeys v r -> NonEmpty (KESPeriod, KESKeyPair v)
aikHot AllIssuerKeys c r
pKeys
      kpDiff :: Word
kpDiff = Word
kesPeriod forall a. Num a => a -> a -> a
- Word
keyRegKesPeriod
      hotKey :: SignKeyKES c
hotKey = case forall v.
(KESAlgorithm v, ContextKES v ~ ()) =>
SignKeyKES v -> KESPeriod -> KESPeriod -> Maybe (SignKeyKES v)
evolveKESUntil SignKeyKES c
sHot (Word -> KESPeriod
KESPeriod Word
0) (Word -> KESPeriod
KESPeriod Word
kpDiff) of
        Maybe (SignKeyKES 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 SignKeyKES c
hKey -> SignKeyKES c
hKey
      sig :: SignedKES (KES c) (BHBody c)
sig = forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SignedKES v a
signedKES () Word
kpDiff BHBody c
bhBody SignKeyKES c
hotKey
   in forall c.
Crypto c =>
BHBody c -> SignedKES 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.KESAlgorithm v, KES.ContextKES v ~ ()) =>
  KES.SignKeyKES v ->
  -- | Current KES period
  KESPeriod ->
  -- | Target KES period
  KESPeriod ->
  Maybe (KES.SignKeyKES v)
evolveKESUntil :: forall v.
(KESAlgorithm v, ContextKES v ~ ()) =>
SignKeyKES v -> KESPeriod -> KESPeriod -> Maybe (SignKeyKES v)
evolveKESUntil SignKeyKES v
sk1 (KESPeriod Word
current) (KESPeriod Word
target) = forall {v}.
(ContextKES v ~ (), KESAlgorithm v) =>
SignKeyKES v -> Word -> Word -> Maybe (SignKeyKES v)
go SignKeyKES v
sk1 Word
current Word
target
  where
    go :: SignKeyKES v -> Word -> Word -> Maybe (SignKeyKES v)
go !SignKeyKES v
_ Word
c Word
t | Word
t forall a. Ord a => a -> a -> Bool
< Word
c = forall a. Maybe a
Nothing
    go !SignKeyKES v
sk Word
c Word
t | Word
c forall a. Eq a => a -> a -> Bool
== Word
t = forall a. a -> Maybe a
Just SignKeyKES v
sk
    go !SignKeyKES v
sk Word
c Word
t = case forall v.
(KESAlgorithm v, HasCallStack) =>
ContextKES v -> SignKeyKES v -> Word -> Maybe (SignKeyKES v)
KES.updateKES () SignKeyKES v
sk Word
c of
      Maybe (SignKeyKES v)
Nothing -> forall a. Maybe a
Nothing
      Just SignKeyKES v
sk' -> SignKeyKES v -> Word -> Word -> Maybe (SignKeyKES v)
go SignKeyKES v
sk' (Word
c forall a. Num a => a -> a -> a
+ Word
1) Word
t

mkBlock ::
  forall era r.
  ( EraSegWits era
  , VRF.Signable (VRF (EraCrypto era)) Seed
  , KES.Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))
  ) =>
  -- | Hash of previous block
  HashHeader (EraCrypto era) ->
  -- | All keys in the stake pool
  AllIssuerKeys (EraCrypto era) 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 (EraCrypto era) ->
  Block (BHeader (EraCrypto era)) era
mkBlock :: forall era (r :: KeyRole).
(EraSegWits era, Signable (VRF (EraCrypto era)) Seed,
 Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))) =>
HashHeader (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> Word
-> Word
-> OCert (EraCrypto era)
-> Block (BHeader (EraCrypto era)) era
mkBlock HashHeader (EraCrypto era)
prev AllIssuerKeys (EraCrypto era) r
pKeys [Tx era]
txns SlotNo
slotNo BlockNo
blockNo Nonce
enonce Word
kesPeriod Word
keyRegKesPeriod OCert (EraCrypto era)
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 (EraCrypto era)) EraIndependentBlockBody
bodyHash = forall era.
EraSegWits era =>
TxSeq era -> Hash (HASH (EraCrypto era)) EraIndependentBlockBody
hashTxSeq @era TxSeq era
txseq
      bhBody :: BHBody (EraCrypto era)
bhBody = forall v (r :: KeyRole).
(ContextVRF (VRF v) ~ (), Signable (VRF v) Seed,
 VRFAlgorithm (VRF v)) =>
ProtVer
-> HashHeader v
-> AllIssuerKeys v r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert v
-> Word32
-> Hash v EraIndependentBlockBody
-> BHBody v
mkBHBody ProtVer
protVer HashHeader (EraCrypto era)
prev AllIssuerKeys (EraCrypto era) r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert (EraCrypto era)
oCert Word32
bodySize Hash (HASH (EraCrypto era)) EraIndependentBlockBody
bodyHash
      bHeader :: BHeader (EraCrypto era)
bHeader = forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys (EraCrypto era) r
pKeys Word
kesPeriod Word
keyRegKesPeriod BHBody (EraCrypto era)
bhBody
   in forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader (EraCrypto era)
bHeader TxSeq era
txseq

-- | Create a block with a faked VRF result.
mkBlockFakeVRF ::
  forall era r.
  ( EraSegWits era
  , VRF.Signable (VRF (EraCrypto era)) (WithResult Seed)
  , KES.Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))
  ) =>
  -- | Hash of previous block
  HashHeader (EraCrypto era) ->
  -- | All keys in the stake pool
  AllIssuerKeys (EraCrypto era) 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 (EraCrypto era) ->
  Block (BHeader (EraCrypto era)) era
mkBlockFakeVRF :: forall era (r :: KeyRole).
(EraSegWits era, Signable (VRF (EraCrypto era)) (WithResult Seed),
 Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))) =>
HashHeader (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert (EraCrypto era)
-> Block (BHeader (EraCrypto era)) era
mkBlockFakeVRF HashHeader (EraCrypto era)
prev AllIssuerKeys (EraCrypto era) r
pKeys [Tx era]
txns SlotNo
slotNo BlockNo
blockNo Nonce
enonce NatNonce
bnonce UnitInterval
l Word
kesPeriod Word
keyRegKesPeriod OCert (EraCrypto era)
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 (EraCrypto era)) EraIndependentBlockBody
bodyHash = forall era.
EraSegWits era =>
TxSeq era -> Hash (HASH (EraCrypto era)) EraIndependentBlockBody
hashTxSeq TxSeq era
txSeq
      bhBody :: BHBody (EraCrypto era)
bhBody =
        forall v (r :: KeyRole).
(ContextVRF (VRF v) ~ (), Signable (VRF v) (WithResult Seed),
 VRFAlgorithm (VRF v)) =>
NatNonce
-> UnitInterval
-> ProtVer
-> HashHeader v
-> AllIssuerKeys v r
-> SlotNo
-> BlockNo
-> Nonce
-> OCert v
-> Word32
-> Hash v EraIndependentBlockBody
-> BHBody v
mkBHBodyFakeVRF NatNonce
bnonce UnitInterval
l ProtVer
protVer HashHeader (EraCrypto era)
prev AllIssuerKeys (EraCrypto era) r
pKeys SlotNo
slotNo BlockNo
blockNo Nonce
enonce OCert (EraCrypto era)
oCert Word32
bodySize Hash (HASH (EraCrypto era)) EraIndependentBlockBody
bodyHash
      bHeader :: BHeader (EraCrypto era)
bHeader = forall c (r :: KeyRole).
(Crypto c, Signable (KES c) (BHBody c)) =>
AllIssuerKeys c r -> Word -> Word -> BHBody c -> BHeader c
mkBHeader AllIssuerKeys (EraCrypto era) r
pKeys Word
kesPeriod Word
keyRegKesPeriod BHBody (EraCrypto era)
bhBody
   in forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader (EraCrypto era)
bHeader TxSeq era
txSeq