{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Protocol.TPraos.BHeader
  ( HashHeader (..),
    PrevHash (..),
    BHeader (BHeader),
    BHBody (..),
    LastAppliedBlock (..),
    BoundedNatural (bvValue, bvMaxValue),
    assertBoundedNatural,
    lastAppliedHash,
    issuerIDfromBHBody,
    checkLeaderValue,
    checkLeaderNatValue,
    bhHash,
    hashHeaderToNonce,
    prevHashToNonce,
    bHeaderSize,
    bhbody,
    hBbsize,
    seedEta,
    seedL,
    mkSeed,
    bnonce,
    makeHeaderView,
  )
where

import Cardano.Binary
  ( Annotator (..),
    Case (..),
    FromCBOR (fromCBOR),
    ToCBOR (..),
    TokenType (TypeNull),
    annotatorSlice,
    decodeNull,
    encodeListLen,
    encodeNull,
    encodePreEncoded,
    peekTokenType,
    serialize',
    serializeEncoding,
    szCases,
    withWordSize,
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util (SignableRepresentation (..))
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.BaseTypes
  ( ActiveSlotCoeff,
    FixedPoint,
    Nonce (..),
    ProtVer (..),
    Seed (..),
    activeSlotLog,
    activeSlotVal,
    mkNonceFromNumber,
    mkNonceFromOutputVRF,
  )
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Hashes
  ( EraIndependentBlockBody,
    EraIndependentBlockHeader,
  )
import Cardano.Ledger.Keys
  ( CertifiedVRF,
    Hash,
    KeyHash,
    KeyRole (..),
    SignedKES,
    VKey,
    VerKeyVRF,
    decodeSignedKES,
    decodeVerKeyVRF,
    encodeSignedKES,
    encodeVerKeyVRF,
    hashKey,
  )
import Cardano.Ledger.NonIntegral (CompareResult (..), taylorExpCmp)
import Cardano.Ledger.Serialization
  ( FromCBORGroup (..),
    ToCBORGroup (..),
    decodeRecordNamed,
    listLenInt,
    runByteBuilder,
  )
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Protocol.TPraos.OCert (OCert (..))
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.DeepSeq (NFData)
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Builder.Extra as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Ratio ((%))
import Data.Typeable
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Numeric.Natural (Natural)

-- | The hash of a Block Header
newtype HashHeader crypto = HashHeader {HashHeader crypto -> Hash crypto EraIndependentBlockHeader
unHashHeader :: Hash crypto EraIndependentBlockHeader}
  deriving stock (Int -> HashHeader crypto -> ShowS
[HashHeader crypto] -> ShowS
HashHeader crypto -> String
(Int -> HashHeader crypto -> ShowS)
-> (HashHeader crypto -> String)
-> ([HashHeader crypto] -> ShowS)
-> Show (HashHeader crypto)
forall crypto. Int -> HashHeader crypto -> ShowS
forall crypto. [HashHeader crypto] -> ShowS
forall crypto. HashHeader crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashHeader crypto] -> ShowS
$cshowList :: forall crypto. [HashHeader crypto] -> ShowS
show :: HashHeader crypto -> String
$cshow :: forall crypto. HashHeader crypto -> String
showsPrec :: Int -> HashHeader crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> HashHeader crypto -> ShowS
Show, HashHeader crypto -> HashHeader crypto -> Bool
(HashHeader crypto -> HashHeader crypto -> Bool)
-> (HashHeader crypto -> HashHeader crypto -> Bool)
-> Eq (HashHeader crypto)
forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashHeader crypto -> HashHeader crypto -> Bool
$c/= :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
== :: HashHeader crypto -> HashHeader crypto -> Bool
$c== :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
Eq, (forall x. HashHeader crypto -> Rep (HashHeader crypto) x)
-> (forall x. Rep (HashHeader crypto) x -> HashHeader crypto)
-> Generic (HashHeader crypto)
forall x. Rep (HashHeader crypto) x -> HashHeader crypto
forall x. HashHeader crypto -> Rep (HashHeader crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (HashHeader crypto) x -> HashHeader crypto
forall crypto x. HashHeader crypto -> Rep (HashHeader crypto) x
$cto :: forall crypto x. Rep (HashHeader crypto) x -> HashHeader crypto
$cfrom :: forall crypto x. HashHeader crypto -> Rep (HashHeader crypto) x
Generic, Eq (HashHeader crypto)
Eq (HashHeader crypto)
-> (HashHeader crypto -> HashHeader crypto -> Ordering)
-> (HashHeader crypto -> HashHeader crypto -> Bool)
-> (HashHeader crypto -> HashHeader crypto -> Bool)
-> (HashHeader crypto -> HashHeader crypto -> Bool)
-> (HashHeader crypto -> HashHeader crypto -> Bool)
-> (HashHeader crypto -> HashHeader crypto -> HashHeader crypto)
-> (HashHeader crypto -> HashHeader crypto -> HashHeader crypto)
-> Ord (HashHeader crypto)
HashHeader crypto -> HashHeader crypto -> Bool
HashHeader crypto -> HashHeader crypto -> Ordering
HashHeader crypto -> HashHeader crypto -> HashHeader crypto
forall crypto. Eq (HashHeader crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
forall crypto. HashHeader crypto -> HashHeader crypto -> Ordering
forall crypto.
HashHeader crypto -> HashHeader crypto -> HashHeader crypto
min :: HashHeader crypto -> HashHeader crypto -> HashHeader crypto
$cmin :: forall crypto.
HashHeader crypto -> HashHeader crypto -> HashHeader crypto
max :: HashHeader crypto -> HashHeader crypto -> HashHeader crypto
$cmax :: forall crypto.
HashHeader crypto -> HashHeader crypto -> HashHeader crypto
>= :: HashHeader crypto -> HashHeader crypto -> Bool
$c>= :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
> :: HashHeader crypto -> HashHeader crypto -> Bool
$c> :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
<= :: HashHeader crypto -> HashHeader crypto -> Bool
$c<= :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
< :: HashHeader crypto -> HashHeader crypto -> Bool
$c< :: forall crypto. HashHeader crypto -> HashHeader crypto -> Bool
compare :: HashHeader crypto -> HashHeader crypto -> Ordering
$ccompare :: forall crypto. HashHeader crypto -> HashHeader crypto -> Ordering
$cp1Ord :: forall crypto. Eq (HashHeader crypto)
Ord)
  deriving newtype (HashHeader crypto -> ()
(HashHeader crypto -> ()) -> NFData (HashHeader crypto)
forall crypto. HashHeader crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: HashHeader crypto -> ()
$crnf :: forall crypto. HashHeader crypto -> ()
NFData, Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
Proxy (HashHeader crypto) -> String
(Context -> HashHeader crypto -> IO (Maybe ThunkInfo))
-> (Context -> HashHeader crypto -> IO (Maybe ThunkInfo))
-> (Proxy (HashHeader crypto) -> String)
-> NoThunks (HashHeader crypto)
forall crypto. Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (HashHeader crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (HashHeader crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (HashHeader crypto) -> String
wNoThunks :: Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> HashHeader crypto -> IO (Maybe ThunkInfo)
NoThunks)

deriving newtype instance CC.Crypto crypto => ToCBOR (HashHeader crypto)

-- | The previous hash of a block
data PrevHash crypto = GenesisHash | BlockHash !(HashHeader crypto)
  deriving (Int -> PrevHash crypto -> ShowS
[PrevHash crypto] -> ShowS
PrevHash crypto -> String
(Int -> PrevHash crypto -> ShowS)
-> (PrevHash crypto -> String)
-> ([PrevHash crypto] -> ShowS)
-> Show (PrevHash crypto)
forall crypto. Int -> PrevHash crypto -> ShowS
forall crypto. [PrevHash crypto] -> ShowS
forall crypto. PrevHash crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrevHash crypto] -> ShowS
$cshowList :: forall crypto. [PrevHash crypto] -> ShowS
show :: PrevHash crypto -> String
$cshow :: forall crypto. PrevHash crypto -> String
showsPrec :: Int -> PrevHash crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PrevHash crypto -> ShowS
Show, PrevHash crypto -> PrevHash crypto -> Bool
(PrevHash crypto -> PrevHash crypto -> Bool)
-> (PrevHash crypto -> PrevHash crypto -> Bool)
-> Eq (PrevHash crypto)
forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrevHash crypto -> PrevHash crypto -> Bool
$c/= :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
== :: PrevHash crypto -> PrevHash crypto -> Bool
$c== :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
Eq, (forall x. PrevHash crypto -> Rep (PrevHash crypto) x)
-> (forall x. Rep (PrevHash crypto) x -> PrevHash crypto)
-> Generic (PrevHash crypto)
forall x. Rep (PrevHash crypto) x -> PrevHash crypto
forall x. PrevHash crypto -> Rep (PrevHash crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PrevHash crypto) x -> PrevHash crypto
forall crypto x. PrevHash crypto -> Rep (PrevHash crypto) x
$cto :: forall crypto x. Rep (PrevHash crypto) x -> PrevHash crypto
$cfrom :: forall crypto x. PrevHash crypto -> Rep (PrevHash crypto) x
Generic, Eq (PrevHash crypto)
Eq (PrevHash crypto)
-> (PrevHash crypto -> PrevHash crypto -> Ordering)
-> (PrevHash crypto -> PrevHash crypto -> Bool)
-> (PrevHash crypto -> PrevHash crypto -> Bool)
-> (PrevHash crypto -> PrevHash crypto -> Bool)
-> (PrevHash crypto -> PrevHash crypto -> Bool)
-> (PrevHash crypto -> PrevHash crypto -> PrevHash crypto)
-> (PrevHash crypto -> PrevHash crypto -> PrevHash crypto)
-> Ord (PrevHash crypto)
PrevHash crypto -> PrevHash crypto -> Bool
PrevHash crypto -> PrevHash crypto -> Ordering
PrevHash crypto -> PrevHash crypto -> PrevHash crypto
forall crypto. Eq (PrevHash crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
forall crypto. PrevHash crypto -> PrevHash crypto -> Ordering
forall crypto.
PrevHash crypto -> PrevHash crypto -> PrevHash crypto
min :: PrevHash crypto -> PrevHash crypto -> PrevHash crypto
$cmin :: forall crypto.
PrevHash crypto -> PrevHash crypto -> PrevHash crypto
max :: PrevHash crypto -> PrevHash crypto -> PrevHash crypto
$cmax :: forall crypto.
PrevHash crypto -> PrevHash crypto -> PrevHash crypto
>= :: PrevHash crypto -> PrevHash crypto -> Bool
$c>= :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
> :: PrevHash crypto -> PrevHash crypto -> Bool
$c> :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
<= :: PrevHash crypto -> PrevHash crypto -> Bool
$c<= :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
< :: PrevHash crypto -> PrevHash crypto -> Bool
$c< :: forall crypto. PrevHash crypto -> PrevHash crypto -> Bool
compare :: PrevHash crypto -> PrevHash crypto -> Ordering
$ccompare :: forall crypto. PrevHash crypto -> PrevHash crypto -> Ordering
$cp1Ord :: forall crypto. Eq (PrevHash crypto)
Ord)

instance CC.Crypto crypto => NoThunks (PrevHash crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (PrevHash crypto)
  where
  toCBOR :: PrevHash crypto -> Encoding
toCBOR PrevHash crypto
GenesisHash = Encoding
encodeNull
  toCBOR (BlockHash HashHeader crypto
h) = HashHeader crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HashHeader crypto
h
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PrevHash crypto) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (PrevHash crypto)
_ =
    [Case Size] -> Size
szCases
      [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"GenesisHash" Size
1,
        Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"BlockHash" ((forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (HashHeader crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (HashHeader crypto)
p)
      ]
    where
      p :: Proxy (HashHeader crypto)
p = Proxy (HashHeader crypto)
forall k (t :: k). Proxy t
Proxy :: Proxy (HashHeader crypto)

instance
  CC.Crypto crypto =>
  FromCBOR (PrevHash crypto)
  where
  fromCBOR :: Decoder s (PrevHash crypto)
fromCBOR = do
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (PrevHash crypto))
-> Decoder s (PrevHash crypto)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeNull -> do
        Decoder s ()
forall s. Decoder s ()
decodeNull
        PrevHash crypto -> Decoder s (PrevHash crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash crypto
forall crypto. PrevHash crypto
GenesisHash
      TokenType
_ -> HashHeader crypto -> PrevHash crypto
forall crypto. HashHeader crypto -> PrevHash crypto
BlockHash (HashHeader crypto -> PrevHash crypto)
-> Decoder s (HashHeader crypto) -> Decoder s (PrevHash crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (HashHeader crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR

deriving newtype instance CC.Crypto crypto => FromCBOR (HashHeader crypto)

data BHBody crypto = BHBody
  { -- | block number
    BHBody crypto -> BlockNo
bheaderBlockNo :: !BlockNo,
    -- | block slot
    BHBody crypto -> SlotNo
bheaderSlotNo :: !SlotNo,
    -- | Hash of the previous block header
    BHBody crypto -> PrevHash crypto
bheaderPrev :: !(PrevHash crypto),
    -- | verification key of block issuer
    BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk :: !(VKey 'BlockIssuer crypto),
    -- | VRF verification key for block issuer
    BHBody crypto -> VerKeyVRF crypto
bheaderVrfVk :: !(VerKeyVRF crypto),
    -- | block nonce
    BHBody crypto -> CertifiedVRF crypto Nonce
bheaderEta :: !(CertifiedVRF crypto Nonce),
    -- | leader election value
    BHBody crypto -> CertifiedVRF crypto Natural
bheaderL :: !(CertifiedVRF crypto Natural),
    -- | Size of the block body
    BHBody crypto -> Natural
bsize :: !Natural,
    -- | Hash of block body
    BHBody crypto -> Hash crypto EraIndependentBlockBody
bhash :: !(Hash crypto EraIndependentBlockBody),
    -- | operational certificate
    BHBody crypto -> OCert crypto
bheaderOCert :: !(OCert crypto),
    -- | protocol version
    BHBody crypto -> ProtVer
bprotver :: !ProtVer
  }
  deriving ((forall x. BHBody crypto -> Rep (BHBody crypto) x)
-> (forall x. Rep (BHBody crypto) x -> BHBody crypto)
-> Generic (BHBody crypto)
forall x. Rep (BHBody crypto) x -> BHBody crypto
forall x. BHBody crypto -> Rep (BHBody crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (BHBody crypto) x -> BHBody crypto
forall crypto x. BHBody crypto -> Rep (BHBody crypto) x
$cto :: forall crypto x. Rep (BHBody crypto) x -> BHBody crypto
$cfrom :: forall crypto x. BHBody crypto -> Rep (BHBody crypto) x
Generic)

deriving instance CC.Crypto crypto => Show (BHBody crypto)

deriving instance CC.Crypto crypto => Eq (BHBody crypto)

instance
  CC.Crypto crypto =>
  SignableRepresentation (BHBody crypto)
  where
  getSignableRepresentation :: BHBody crypto -> ByteString
getSignableRepresentation = BHBody crypto -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

instance
  CC.Crypto crypto =>
  NoThunks (BHBody crypto)

instance
  CC.Crypto crypto =>
  ToCBOR (BHBody crypto)
  where
  toCBOR :: BHBody crypto -> Encoding
toCBOR BHBody crypto
bhBody =
    Word -> Encoding
encodeListLen (Word
9 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ OCert crypto -> Word
forall a. ToCBORGroup a => a -> Word
listLen OCert crypto
oc Word -> Word -> Word
forall a. Num a => a -> a -> a
+ ProtVer -> Word
forall a. ToCBORGroup a => a -> Word
listLen ProtVer
pv)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlockNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> BlockNo
forall crypto. BHBody crypto -> BlockNo
bheaderBlockNo BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> SlotNo
forall crypto. BHBody crypto -> SlotNo
bheaderSlotNo BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PrevHash crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VKey 'BlockIssuer crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> VKey 'BlockIssuer crypto
forall crypto. BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerKeyVRF (VRF crypto) -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF (BHBody crypto -> VerKeyVRF (VRF crypto)
forall crypto. BHBody crypto -> VerKeyVRF crypto
bheaderVrfVk BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertifiedVRF (VRF crypto) Nonce -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> CertifiedVRF (VRF crypto) Nonce
forall crypto. BHBody crypto -> CertifiedVRF crypto Nonce
bheaderEta BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertifiedVRF (VRF crypto) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> CertifiedVRF (VRF crypto) Natural
forall crypto. BHBody crypto -> CertifiedVRF crypto Natural
bheaderL BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> Natural
forall crypto. BHBody crypto -> Natural
bsize BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash (HASH crypto) EraIndependentBlockBody -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (BHBody crypto -> Hash (HASH crypto) EraIndependentBlockBody
forall crypto. BHBody crypto -> Hash crypto EraIndependentBlockBody
bhash BHBody crypto
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> OCert crypto -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup OCert crypto
oc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtVer -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup ProtVer
pv
    where
      oc :: OCert crypto
oc = BHBody crypto -> OCert crypto
forall crypto. BHBody crypto -> OCert crypto
bheaderOCert BHBody crypto
bhBody
      pv :: ProtVer
pv = BHBody crypto -> ProtVer
forall crypto. BHBody crypto -> ProtVer
bprotver BHBody crypto
bhBody

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHBody crypto) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (BHBody crypto)
proxy =
    Integer -> Size
forall a. Num a => Integer -> a
fromInteger (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Word -> Integer) -> Word -> Integer
forall a b. (a -> b) -> a -> b
$ Word
9 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy (OCert crypto) -> Word
forall a. ToCBORGroup a => Proxy a -> Word
listLenBound Proxy (OCert crypto)
oc Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Proxy ProtVer -> Word
forall a. ToCBORGroup a => Proxy a -> Word
listLenBound Proxy ProtVer
pv)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy BlockNo -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> BlockNo
forall crypto. BHBody crypto -> BlockNo
bheaderBlockNo (BHBody crypto -> BlockNo)
-> Proxy (BHBody crypto) -> Proxy BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SlotNo -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> SlotNo
forall crypto. BHBody crypto -> SlotNo
bheaderSlotNo (BHBody crypto -> SlotNo) -> Proxy (BHBody crypto) -> Proxy SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PrevHash crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> PrevHash crypto
forall crypto. BHBody crypto -> PrevHash crypto
bheaderPrev (BHBody crypto -> PrevHash crypto)
-> Proxy (BHBody crypto) -> Proxy (PrevHash crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VKey 'BlockIssuer crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> VKey 'BlockIssuer crypto
forall crypto. BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk (BHBody crypto -> VKey 'BlockIssuer crypto)
-> Proxy (BHBody crypto) -> Proxy (VKey 'BlockIssuer crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (VerKeyVRF (VRF crypto)) -> Size
forall v. VRFAlgorithm v => Proxy (VerKeyVRF v) -> Size
VRF.encodedVerKeyVRFSizeExpr (BHBody crypto -> VerKeyVRF (VRF crypto)
forall crypto. BHBody crypto -> VerKeyVRF crypto
bheaderVrfVk (BHBody crypto -> VerKeyVRF (VRF crypto))
-> Proxy (BHBody crypto) -> Proxy (VerKeyVRF (VRF crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CertifiedVRF (VRF crypto) Nonce) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> CertifiedVRF (VRF crypto) Nonce
forall crypto. BHBody crypto -> CertifiedVRF crypto Nonce
bheaderEta (BHBody crypto -> CertifiedVRF (VRF crypto) Nonce)
-> Proxy (BHBody crypto) -> Proxy (CertifiedVRF (VRF crypto) Nonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CertifiedVRF (VRF crypto) Natural) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> CertifiedVRF (VRF crypto) Natural
forall crypto. BHBody crypto -> CertifiedVRF crypto Natural
bheaderL (BHBody crypto -> CertifiedVRF (VRF crypto) Natural)
-> Proxy (BHBody crypto)
-> Proxy (CertifiedVRF (VRF crypto) Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word64 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Natural -> Word64
toWord64 (Natural -> Word64)
-> (BHBody crypto -> Natural) -> BHBody crypto -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody crypto -> Natural
forall crypto. BHBody crypto -> Natural
bsize (BHBody crypto -> Word64) -> Proxy (BHBody crypto) -> Proxy Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash (HASH crypto) EraIndependentBlockBody) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> Hash (HASH crypto) EraIndependentBlockBody
forall crypto. BHBody crypto -> Hash crypto EraIndependentBlockBody
bhash (BHBody crypto -> Hash (HASH crypto) EraIndependentBlockBody)
-> Proxy (BHBody crypto)
-> Proxy (Hash (HASH crypto) EraIndependentBlockBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> OCert crypto
forall crypto. BHBody crypto -> OCert crypto
bheaderOCert (BHBody crypto -> OCert crypto)
-> Proxy (BHBody crypto) -> Proxy (OCert crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ProtVer -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHBody crypto -> ProtVer
forall crypto. BHBody crypto -> ProtVer
bprotver (BHBody crypto -> ProtVer)
-> Proxy (BHBody crypto) -> Proxy ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy)
    where
      oc :: Proxy (OCert crypto)
oc = BHBody crypto -> OCert crypto
forall crypto. BHBody crypto -> OCert crypto
bheaderOCert (BHBody crypto -> OCert crypto)
-> Proxy (BHBody crypto) -> Proxy (OCert crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy
      pv :: Proxy ProtVer
pv = BHBody crypto -> ProtVer
forall crypto. BHBody crypto -> ProtVer
bprotver (BHBody crypto -> ProtVer)
-> Proxy (BHBody crypto) -> Proxy ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHBody crypto)
proxy
      toWord64 :: Natural -> Word64
      toWord64 :: Natural -> Word64
toWord64 = Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance
  CC.Crypto crypto =>
  FromCBOR (BHBody crypto)
  where
  fromCBOR :: Decoder s (BHBody crypto)
fromCBOR = Text
-> (BHBody crypto -> Int)
-> Decoder s (BHBody crypto)
-> Decoder s (BHBody crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BHBody" BHBody crypto -> Int
forall crypto. Crypto crypto => BHBody crypto -> Int
bhBodySize (Decoder s (BHBody crypto) -> Decoder s (BHBody crypto))
-> Decoder s (BHBody crypto) -> Decoder s (BHBody crypto)
forall a b. (a -> b) -> a -> b
$ do
    BlockNo
bheaderBlockNo <- Decoder s BlockNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    SlotNo
bheaderSlotNo <- Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    PrevHash crypto
bheaderPrev <- Decoder s (PrevHash crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    VKey 'BlockIssuer crypto
bheaderVk <- Decoder s (VKey 'BlockIssuer crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    VerKeyVRF (VRF crypto)
bheaderVrfVk <- Decoder s (VerKeyVRF (VRF crypto))
forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF
    CertifiedVRF (VRF crypto) Nonce
bheaderEta <- Decoder s (CertifiedVRF (VRF crypto) Nonce)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    CertifiedVRF (VRF crypto) Natural
bheaderL <- Decoder s (CertifiedVRF (VRF crypto) Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Natural
bsize <- Decoder s Natural
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Hash (HASH crypto) EraIndependentBlockBody
bhash <- Decoder s (Hash (HASH crypto) EraIndependentBlockBody)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    OCert crypto
bheaderOCert <- Decoder s (OCert crypto)
forall a s. FromCBORGroup a => Decoder s a
fromCBORGroup
    ProtVer
bprotver <- Decoder s ProtVer
forall a s. FromCBORGroup a => Decoder s a
fromCBORGroup
    BHBody crypto -> Decoder s (BHBody crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BHBody crypto -> Decoder s (BHBody crypto))
-> BHBody crypto -> Decoder s (BHBody crypto)
forall a b. (a -> b) -> a -> b
$
      BHBody :: forall crypto.
BlockNo
-> SlotNo
-> PrevHash crypto
-> VKey 'BlockIssuer crypto
-> VerKeyVRF crypto
-> CertifiedVRF crypto Nonce
-> CertifiedVRF crypto Natural
-> Natural
-> Hash crypto EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> BHBody crypto
BHBody
        { BlockNo
bheaderBlockNo :: BlockNo
bheaderBlockNo :: BlockNo
bheaderBlockNo,
          SlotNo
bheaderSlotNo :: SlotNo
bheaderSlotNo :: SlotNo
bheaderSlotNo,
          PrevHash crypto
bheaderPrev :: PrevHash crypto
bheaderPrev :: PrevHash crypto
bheaderPrev,
          VKey 'BlockIssuer crypto
bheaderVk :: VKey 'BlockIssuer crypto
bheaderVk :: VKey 'BlockIssuer crypto
bheaderVk,
          VerKeyVRF (VRF crypto)
bheaderVrfVk :: VerKeyVRF (VRF crypto)
bheaderVrfVk :: VerKeyVRF (VRF crypto)
bheaderVrfVk,
          CertifiedVRF (VRF crypto) Nonce
bheaderEta :: CertifiedVRF (VRF crypto) Nonce
bheaderEta :: CertifiedVRF (VRF crypto) Nonce
bheaderEta,
          CertifiedVRF (VRF crypto) Natural
bheaderL :: CertifiedVRF (VRF crypto) Natural
bheaderL :: CertifiedVRF (VRF crypto) Natural
bheaderL,
          Natural
bsize :: Natural
bsize :: Natural
bsize,
          Hash (HASH crypto) EraIndependentBlockBody
bhash :: Hash (HASH crypto) EraIndependentBlockBody
bhash :: Hash (HASH crypto) EraIndependentBlockBody
bhash,
          OCert crypto
bheaderOCert :: OCert crypto
bheaderOCert :: OCert crypto
bheaderOCert,
          ProtVer
bprotver :: ProtVer
bprotver :: ProtVer
bprotver
        }
    where
      bhBodySize :: BHBody crypto -> Int
bhBodySize BHBody crypto
body = Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OCert crypto -> Int
forall a. ToCBORGroup a => a -> Int
listLenInt (BHBody crypto -> OCert crypto
forall crypto. BHBody crypto -> OCert crypto
bheaderOCert BHBody crypto
body) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ProtVer -> Int
forall a. ToCBORGroup a => a -> Int
listLenInt (BHBody crypto -> ProtVer
forall crypto. BHBody crypto -> ProtVer
bprotver BHBody crypto
body)

data BHeader crypto = BHeader'
  { BHeader crypto -> BHBody crypto
bHeaderBody' :: !(BHBody crypto),
    BHeader crypto -> SignedKES crypto (BHBody crypto)
bHeaderSig' :: !(SignedKES crypto (BHBody crypto)),
    BHeader crypto -> ByteString
bHeaderBytes :: !BSL.ByteString
  }
  deriving ((forall x. BHeader crypto -> Rep (BHeader crypto) x)
-> (forall x. Rep (BHeader crypto) x -> BHeader crypto)
-> Generic (BHeader crypto)
forall x. Rep (BHeader crypto) x -> BHeader crypto
forall x. BHeader crypto -> Rep (BHeader crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (BHeader crypto) x -> BHeader crypto
forall crypto x. BHeader crypto -> Rep (BHeader crypto) x
$cto :: forall crypto x. Rep (BHeader crypto) x -> BHeader crypto
$cfrom :: forall crypto x. BHeader crypto -> Rep (BHeader crypto) x
Generic)

deriving via
  AllowThunksIn '["bHeaderBytes"] (BHeader crypto)
  instance
    CC.Crypto crypto => NoThunks (BHeader crypto)

deriving instance CC.Crypto crypto => Eq (BHeader crypto)

deriving instance CC.Crypto crypto => Show (BHeader crypto)

pattern BHeader ::
  CC.Crypto crypto =>
  BHBody crypto ->
  SignedKES crypto (BHBody crypto) ->
  BHeader crypto
pattern $bBHeader :: BHBody crypto -> SignedKES crypto (BHBody crypto) -> BHeader crypto
$mBHeader :: forall r crypto.
Crypto crypto =>
BHeader crypto
-> (BHBody crypto -> SignedKES crypto (BHBody crypto) -> r)
-> (Void# -> r)
-> r
BHeader bHeaderBody' bHeaderSig' <-
  BHeader' {bHeaderBody', bHeaderSig'}
  where
    BHeader BHBody crypto
body SignedKES crypto (BHBody crypto)
sig =
      let mkBytes :: a -> SignedKES v a -> ByteString
mkBytes a
bhBody SignedKES v a
kESig =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen Word
2
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
bhBody
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedKES v a -> Encoding
forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES SignedKES v a
kESig
       in BHBody crypto
-> SignedKES crypto (BHBody crypto) -> ByteString -> BHeader crypto
forall crypto.
BHBody crypto
-> SignedKES crypto (BHBody crypto) -> ByteString -> BHeader crypto
BHeader' BHBody crypto
body SignedKES crypto (BHBody crypto)
sig (BHBody crypto -> SignedKES crypto (BHBody crypto) -> ByteString
forall a v a.
(ToCBOR a, KESAlgorithm v) =>
a -> SignedKES v a -> ByteString
mkBytes BHBody crypto
body SignedKES crypto (BHBody crypto)
sig)

{-# COMPLETE BHeader #-}

instance
  CC.Crypto crypto =>
  ToCBOR (BHeader crypto)
  where
  toCBOR :: BHeader crypto -> Encoding
toCBOR (BHeader' BHBody crypto
_ SignedKES crypto (BHBody crypto)
_ ByteString
bytes) = ByteString -> Encoding
encodePreEncoded (ByteString -> ByteString
BSL.toStrict ByteString
bytes)
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHeader crypto) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (BHeader crypto)
proxy =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHBody crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (BHeader crypto -> BHBody crypto
forall crypto. BHeader crypto -> BHBody crypto
bHeaderBody' (BHeader crypto -> BHBody crypto)
-> Proxy (BHeader crypto) -> Proxy (BHBody crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHeader crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (SigKES (KES crypto)) -> Size
forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
KES.encodedSigKESSizeExpr (SignedKES crypto (BHBody crypto) -> SigKES (KES crypto)
forall v a. SignedKES v a -> SigKES v
KES.getSig (SignedKES crypto (BHBody crypto) -> SigKES (KES crypto))
-> (BHeader crypto -> SignedKES crypto (BHBody crypto))
-> BHeader crypto
-> SigKES (KES crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader crypto -> SignedKES crypto (BHBody crypto)
forall crypto. BHeader crypto -> SignedKES crypto (BHBody crypto)
bHeaderSig' (BHeader crypto -> SigKES (KES crypto))
-> Proxy (BHeader crypto) -> Proxy (SigKES (KES crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHeader crypto)
proxy)

instance
  CC.Crypto crypto =>
  FromCBOR (Annotator (BHeader crypto))
  where
  fromCBOR :: Decoder s (Annotator (BHeader crypto))
fromCBOR = Decoder s (Annotator (ByteString -> BHeader crypto))
-> Decoder s (Annotator (BHeader crypto))
forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice (Decoder s (Annotator (ByteString -> BHeader crypto))
 -> Decoder s (Annotator (BHeader crypto)))
-> Decoder s (Annotator (ByteString -> BHeader crypto))
-> Decoder s (Annotator (BHeader crypto))
forall a b. (a -> b) -> a -> b
$
    Text
-> (Annotator (ByteString -> BHeader crypto) -> Int)
-> Decoder s (Annotator (ByteString -> BHeader crypto))
-> Decoder s (Annotator (ByteString -> BHeader crypto))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Header" (Int -> Annotator (ByteString -> BHeader crypto) -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (Annotator (ByteString -> BHeader crypto))
 -> Decoder s (Annotator (ByteString -> BHeader crypto)))
-> Decoder s (Annotator (ByteString -> BHeader crypto))
-> Decoder s (Annotator (ByteString -> BHeader crypto))
forall a b. (a -> b) -> a -> b
$ do
      BHBody crypto
bhb <- Decoder s (BHBody crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SignedKES (KES crypto) (BHBody crypto)
sig <- Decoder s (SignedKES (KES crypto) (BHBody crypto))
forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES
      Annotator (ByteString -> BHeader crypto)
-> Decoder s (Annotator (ByteString -> BHeader crypto))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (ByteString -> BHeader crypto)
 -> Decoder s (Annotator (ByteString -> BHeader crypto)))
-> Annotator (ByteString -> BHeader crypto)
-> Decoder s (Annotator (ByteString -> BHeader crypto))
forall a b. (a -> b) -> a -> b
$ (ByteString -> BHeader crypto)
-> Annotator (ByteString -> BHeader crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> BHeader crypto)
 -> Annotator (ByteString -> BHeader crypto))
-> (ByteString -> BHeader crypto)
-> Annotator (ByteString -> BHeader crypto)
forall a b. (a -> b) -> a -> b
$ BHBody crypto
-> SignedKES (KES crypto) (BHBody crypto)
-> ByteString
-> BHeader crypto
forall crypto.
BHBody crypto
-> SignedKES crypto (BHBody crypto) -> ByteString -> BHeader crypto
BHeader' BHBody crypto
bhb SignedKES (KES crypto) (BHBody crypto)
sig

-- | Hash a given block header
bhHash ::
  CC.Crypto crypto =>
  BHeader crypto ->
  HashHeader crypto
bhHash :: BHeader crypto -> HashHeader crypto
bhHash = Hash (HASH crypto) EraIndependentBlockHeader -> HashHeader crypto
forall crypto.
Hash crypto EraIndependentBlockHeader -> HashHeader crypto
HashHeader (Hash (HASH crypto) EraIndependentBlockHeader -> HashHeader crypto)
-> (BHeader crypto -> Hash (HASH crypto) EraIndependentBlockHeader)
-> BHeader crypto
-> HashHeader crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH crypto) (BHeader crypto)
-> Hash (HASH crypto) EraIndependentBlockHeader
forall h a b. Hash h a -> Hash h b
Hash.castHash (Hash (HASH crypto) (BHeader crypto)
 -> Hash (HASH crypto) EraIndependentBlockHeader)
-> (BHeader crypto -> Hash (HASH crypto) (BHeader crypto))
-> BHeader crypto
-> Hash (HASH crypto) EraIndependentBlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BHeader crypto -> Encoding)
-> BHeader crypto -> Hash (HASH crypto) (BHeader crypto)
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Hash.hashWithSerialiser BHeader crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

-- | HashHeader to Nonce
-- What is going on here?
-- This is here because the surrounding code is parametrized in the hash algorithm used,
-- but the nonce is hard-coded to Blake2b_256.
-- We require the nonce to have the right length (the size of a Blake2b_256 hash), so
-- if the hash size differs, we pad or remove bytes accordingly.
hashHeaderToNonce :: HashHeader crypto -> Nonce
hashHeaderToNonce :: HashHeader crypto -> Nonce
hashHeaderToNonce (HashHeader Hash crypto EraIndependentBlockHeader
h) = case ByteString -> Maybe (Hash Blake2b_256 Nonce)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
bytes of
  Maybe (Hash Blake2b_256 Nonce)
Nothing -> Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
Hash.castHash ((ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
bytes))
  Just Hash Blake2b_256 Nonce
hash -> Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> Hash Blake2b_256 Nonce -> Nonce
forall a b. (a -> b) -> a -> b
$! Hash Blake2b_256 Nonce
hash
  where
    bytes :: ByteString
bytes = Hash crypto EraIndependentBlockHeader -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash crypto EraIndependentBlockHeader
h

prevHashToNonce ::
  PrevHash crypto ->
  Nonce
prevHashToNonce :: PrevHash crypto -> Nonce
prevHashToNonce = \case
  PrevHash crypto
GenesisHash -> Nonce
NeutralNonce -- This case can only happen when starting Shelley from genesis,
  -- setting the intial chain state to some epoch e,
  -- and having the first block be in epoch e+1.
  -- In this edge case there is no need to add any extra
  -- entropy via the previous header hash to the next epoch nonce,
  -- so using the neutral nonce is appropriate.
  BlockHash HashHeader crypto
ph -> HashHeader crypto -> Nonce
forall crypto. HashHeader crypto -> Nonce
hashHeaderToNonce HashHeader crypto
ph

-- | Retrieve the issuer id (the hash of the cold key) from the body of the block header.
-- This corresponds to either a genesis/core node or a stake pool.
issuerIDfromBHBody :: CC.Crypto crypto => BHBody crypto -> KeyHash 'BlockIssuer crypto
issuerIDfromBHBody :: BHBody crypto -> KeyHash 'BlockIssuer crypto
issuerIDfromBHBody = VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey (VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto)
-> (BHBody crypto -> VKey 'BlockIssuer crypto)
-> BHBody crypto
-> KeyHash 'BlockIssuer crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody crypto -> VKey 'BlockIssuer crypto
forall crypto. BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk

bHeaderSize :: forall crypto. BHeader crypto -> Int
bHeaderSize :: BHeader crypto -> Int
bHeaderSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (BHeader crypto -> Int64) -> BHeader crypto -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length (ByteString -> Int64)
-> (BHeader crypto -> ByteString) -> BHeader crypto -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader crypto -> ByteString
forall crypto. BHeader crypto -> ByteString
bHeaderBytes

bhbody ::
  CC.Crypto crypto =>
  BHeader crypto ->
  BHBody crypto
bhbody :: BHeader crypto -> BHBody crypto
bhbody (BHeader BHBody crypto
b SignedKES crypto (BHBody crypto)
_) = BHBody crypto
b

hBbsize :: BHBody crypto -> Natural
hBbsize :: BHBody crypto -> Natural
hBbsize = BHBody crypto -> Natural
forall crypto. BHBody crypto -> Natural
bsize

-- | Natural value with some additional bound. It must always be the base that
-- 'bvValue <= bvMaxValue'. The creator is responsible for checking this value.
data BoundedNatural = UnsafeBoundedNatural
  { BoundedNatural -> Natural
bvMaxValue :: Natural,
    BoundedNatural -> Natural
bvValue :: Natural
  }

-- | Assert that a natural is bounded by a certain value. Throws an error when
-- this is not the case.
assertBoundedNatural ::
  -- | Maximum bound
  Natural ->
  -- | Value
  Natural ->
  BoundedNatural
assertBoundedNatural :: Natural -> Natural -> BoundedNatural
assertBoundedNatural Natural
maxVal Natural
val =
  if Natural
val Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxVal
    then Natural -> Natural -> BoundedNatural
UnsafeBoundedNatural Natural
maxVal Natural
val
    else String -> BoundedNatural
forall a. HasCallStack => String -> a
error (String -> BoundedNatural) -> String -> BoundedNatural
forall a b. (a -> b) -> a -> b
$ Natural -> String
forall a. Show a => a -> String
show Natural
val String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is greater than max value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show Natural
maxVal

-- | Check that the certified VRF output, when used as a natural, is valid for
-- being slot leader.
checkLeaderValue ::
  forall v.
  (VRF.VRFAlgorithm v) =>
  VRF.OutputVRF v ->
  Rational ->
  ActiveSlotCoeff ->
  Bool
checkLeaderValue :: OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue OutputVRF v
certVRF Rational
σ ActiveSlotCoeff
f =
  BoundedNatural -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderNatValue (Natural -> Natural -> BoundedNatural
assertBoundedNatural Natural
certNatMax (OutputVRF v -> Natural
forall v. OutputVRF v -> Natural
VRF.getOutputVRFNatural OutputVRF v
certVRF)) Rational
σ ActiveSlotCoeff
f
  where
    certNatMax :: Natural
    certNatMax :: Natural
certNatMax = (Natural
2 :: Natural) Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
8 Word -> Word -> Word
forall a. Num a => a -> a -> a
* OutputVRF v -> Word
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
VRF.sizeOutputVRF OutputVRF v
certVRF)

-- | Check that the certified input natural is valid for being slot leader. This
-- means we check that
--
-- p < 1 - (1 - f)^σ
--
-- where p = certNat / certNatMax.
--
-- The calculation is done using the following optimization:
--
-- let q = 1 - p and c = ln(1 - f)
--
-- then           p < 1 - (1 - f)^σ
-- <=>  1 / (1 - p) < exp(-σ * c)
-- <=>  1 / q       < exp(-σ * c)
--
-- This can be efficiently be computed by `taylorExpCmp` which returns `ABOVE`
-- in case the reference value `1 / (1 - p)` is above the exponential function
-- at `-σ * c`, `BELOW` if it is below or `MaxReached` if it couldn't
-- conclusively compute this within the given iteration bounds.
--
-- Note that  1       1               1                         certNatMax
--           --- =  ----- = ---------------------------- = ----------------------
--            q     1 - p    1 - (certNat / certNatMax)    (certNatMax - certNat)
checkLeaderNatValue ::
  -- | Certified nat value
  BoundedNatural ->
  -- | Stake proportion
  Rational ->
  ActiveSlotCoeff ->
  Bool
checkLeaderNatValue :: BoundedNatural -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderNatValue BoundedNatural
bn Rational
σ ActiveSlotCoeff
f =
  if ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
f PositiveUnitInterval -> PositiveUnitInterval -> Bool
forall a. Eq a => a -> a -> Bool
== PositiveUnitInterval
forall a. Bounded a => a
maxBound
    then -- If the active slot coefficient is equal to one,
    -- then nearly every stake pool can produce a block every slot.
    -- In this degenerate case, where ln (1-f) is not defined,
    -- we let the VRF leader check always succeed.
    -- This is a testing convenience, the active slot coefficient should not
    -- bet set above one half otherwise.
      Bool
True
    else case FixedPoint -> FixedPoint -> FixedPoint -> CompareResult FixedPoint
forall a. RealFrac a => a -> a -> a -> CompareResult a
taylorExpCmp FixedPoint
3 FixedPoint
recip_q FixedPoint
x of
      ABOVE FixedPoint
_ Int
_ -> Bool
False
      BELOW FixedPoint
_ Int
_ -> Bool
True
      MaxReached Int
_ -> Bool
False
  where
    c, recip_q, x :: FixedPoint
    c :: FixedPoint
c = ActiveSlotCoeff -> FixedPoint
activeSlotLog ActiveSlotCoeff
f
    recip_q :: FixedPoint
recip_q = Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
certNatMax Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural
certNatMax Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
certNat))
    x :: FixedPoint
x = -Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational Rational
σ FixedPoint -> FixedPoint -> FixedPoint
forall a. Num a => a -> a -> a
* FixedPoint
c
    certNatMax :: Natural
certNatMax = BoundedNatural -> Natural
bvMaxValue BoundedNatural
bn
    certNat :: Natural
certNat = BoundedNatural -> Natural
bvValue BoundedNatural
bn

seedEta :: Nonce
seedEta :: Nonce
seedEta = Word64 -> Nonce
mkNonceFromNumber Word64
0

seedL :: Nonce
seedL :: Nonce
seedL = Word64 -> Nonce
mkNonceFromNumber Word64
1

-- | Construct a seed to use in the VRF computation.
mkSeed ::
  -- | Universal constant
  Nonce ->
  SlotNo ->
  -- | Epoch nonce
  Nonce ->
  Seed
mkSeed :: Nonce -> SlotNo -> Nonce -> Seed
mkSeed Nonce
ucNonce (SlotNo Word64
slot) Nonce
eNonce =
  Hash Blake2b_256 Seed -> Seed
Seed
    (Hash Blake2b_256 Seed -> Seed)
-> (Builder -> Hash Blake2b_256 Seed) -> Builder -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( case Nonce
ucNonce of
          Nonce
NeutralNonce -> Hash Blake2b_256 Seed -> Hash Blake2b_256 Seed
forall a. a -> a
id
          Nonce Hash Blake2b_256 Nonce
h -> Hash Blake2b_256 Seed
-> Hash Blake2b_256 Seed -> Hash Blake2b_256 Seed
forall h a. Hash h a -> Hash h a -> Hash h a
Hash.xor (Hash Blake2b_256 Nonce -> Hash Blake2b_256 Seed
forall h a b. Hash h a -> Hash h b
Hash.castHash Hash Blake2b_256 Nonce
h)
      )
    (Hash Blake2b_256 Seed -> Hash Blake2b_256 Seed)
-> (Builder -> Hash Blake2b_256 Seed)
-> Builder
-> Hash Blake2b_256 Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString -> Hash Blake2b_256 Seed
forall h a b. Hash h a -> Hash h b
Hash.castHash
    (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Seed)
-> (Builder -> Hash Blake2b_256 ByteString)
-> Builder
-> Hash Blake2b_256 Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
    (ByteString -> Hash Blake2b_256 ByteString)
-> (Builder -> ByteString)
-> Builder
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> ByteString
runByteBuilder (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
    (Builder -> Seed) -> Builder -> Seed
forall a b. (a -> b) -> a -> b
$ Word64 -> Builder
BS.word64BE Word64
slot
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case Nonce
eNonce of
             Nonce
NeutralNonce -> Builder
forall a. Monoid a => a
mempty
             Nonce Hash Blake2b_256 Nonce
h -> ByteString -> Builder
BS.byteStringCopy (Hash Blake2b_256 Nonce -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash Blake2b_256 Nonce
h)
         )

data LastAppliedBlock crypto = LastAppliedBlock
  { LastAppliedBlock crypto -> BlockNo
labBlockNo :: !BlockNo,
    LastAppliedBlock crypto -> SlotNo
labSlotNo :: !SlotNo,
    LastAppliedBlock crypto -> HashHeader crypto
labHash :: !(HashHeader crypto)
  }
  deriving (Int -> LastAppliedBlock crypto -> ShowS
[LastAppliedBlock crypto] -> ShowS
LastAppliedBlock crypto -> String
(Int -> LastAppliedBlock crypto -> ShowS)
-> (LastAppliedBlock crypto -> String)
-> ([LastAppliedBlock crypto] -> ShowS)
-> Show (LastAppliedBlock crypto)
forall crypto. Int -> LastAppliedBlock crypto -> ShowS
forall crypto. [LastAppliedBlock crypto] -> ShowS
forall crypto. LastAppliedBlock crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LastAppliedBlock crypto] -> ShowS
$cshowList :: forall crypto. [LastAppliedBlock crypto] -> ShowS
show :: LastAppliedBlock crypto -> String
$cshow :: forall crypto. LastAppliedBlock crypto -> String
showsPrec :: Int -> LastAppliedBlock crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> LastAppliedBlock crypto -> ShowS
Show, LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
(LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool)
-> (LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool)
-> Eq (LastAppliedBlock crypto)
forall crypto.
LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
$c/= :: forall crypto.
LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
== :: LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
$c== :: forall crypto.
LastAppliedBlock crypto -> LastAppliedBlock crypto -> Bool
Eq, (forall x.
 LastAppliedBlock crypto -> Rep (LastAppliedBlock crypto) x)
-> (forall x.
    Rep (LastAppliedBlock crypto) x -> LastAppliedBlock crypto)
-> Generic (LastAppliedBlock crypto)
forall x.
Rep (LastAppliedBlock crypto) x -> LastAppliedBlock crypto
forall x.
LastAppliedBlock crypto -> Rep (LastAppliedBlock crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (LastAppliedBlock crypto) x -> LastAppliedBlock crypto
forall crypto x.
LastAppliedBlock crypto -> Rep (LastAppliedBlock crypto) x
$cto :: forall crypto x.
Rep (LastAppliedBlock crypto) x -> LastAppliedBlock crypto
$cfrom :: forall crypto x.
LastAppliedBlock crypto -> Rep (LastAppliedBlock crypto) x
Generic)

instance CC.Crypto crypto => NoThunks (LastAppliedBlock crypto)

instance NFData (LastAppliedBlock crypto)

instance CC.Crypto crypto => ToCBOR (LastAppliedBlock crypto) where
  toCBOR :: LastAppliedBlock crypto -> Encoding
toCBOR (LastAppliedBlock BlockNo
b SlotNo
s HashHeader crypto
h) =
    Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlockNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR BlockNo
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
s Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> HashHeader crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HashHeader crypto
h

instance CC.Crypto crypto => FromCBOR (LastAppliedBlock crypto) where
  fromCBOR :: Decoder s (LastAppliedBlock crypto)
fromCBOR =
    Text
-> (LastAppliedBlock crypto -> Int)
-> Decoder s (LastAppliedBlock crypto)
-> Decoder s (LastAppliedBlock crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"lastAppliedBlock"
      (Int -> LastAppliedBlock crypto -> Int
forall a b. a -> b -> a
const Int
3)
      ( BlockNo -> SlotNo -> HashHeader crypto -> LastAppliedBlock crypto
forall crypto.
BlockNo -> SlotNo -> HashHeader crypto -> LastAppliedBlock crypto
LastAppliedBlock
          (BlockNo -> SlotNo -> HashHeader crypto -> LastAppliedBlock crypto)
-> Decoder s BlockNo
-> Decoder
     s (SlotNo -> HashHeader crypto -> LastAppliedBlock crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s BlockNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Decoder s (SlotNo -> HashHeader crypto -> LastAppliedBlock crypto)
-> Decoder s SlotNo
-> Decoder s (HashHeader crypto -> LastAppliedBlock crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Decoder s (HashHeader crypto -> LastAppliedBlock crypto)
-> Decoder s (HashHeader crypto)
-> Decoder s (LastAppliedBlock crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (HashHeader crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      )

lastAppliedHash :: WithOrigin (LastAppliedBlock crypto) -> PrevHash crypto
lastAppliedHash :: WithOrigin (LastAppliedBlock crypto) -> PrevHash crypto
lastAppliedHash WithOrigin (LastAppliedBlock crypto)
Origin = PrevHash crypto
forall crypto. PrevHash crypto
GenesisHash
lastAppliedHash (At LastAppliedBlock crypto
lab) = HashHeader crypto -> PrevHash crypto
forall crypto. HashHeader crypto -> PrevHash crypto
BlockHash (HashHeader crypto -> PrevHash crypto)
-> HashHeader crypto -> PrevHash crypto
forall a b. (a -> b) -> a -> b
$ LastAppliedBlock crypto -> HashHeader crypto
forall crypto. LastAppliedBlock crypto -> HashHeader crypto
labHash LastAppliedBlock crypto
lab

-- | Retrieve the new nonce from the block header body.
bnonce :: BHBody crypto -> Nonce
bnonce :: BHBody crypto -> Nonce
bnonce = OutputVRF (VRF crypto) -> Nonce
forall v. OutputVRF v -> Nonce
mkNonceFromOutputVRF (OutputVRF (VRF crypto) -> Nonce)
-> (BHBody crypto -> OutputVRF (VRF crypto))
-> BHBody crypto
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertifiedVRF (VRF crypto) Nonce -> OutputVRF (VRF crypto)
forall v a. CertifiedVRF v a -> OutputVRF v
VRF.certifiedOutput (CertifiedVRF (VRF crypto) Nonce -> OutputVRF (VRF crypto))
-> (BHBody crypto -> CertifiedVRF (VRF crypto) Nonce)
-> BHBody crypto
-> OutputVRF (VRF crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody crypto -> CertifiedVRF (VRF crypto) Nonce
forall crypto. BHBody crypto -> CertifiedVRF crypto Nonce
bheaderEta

makeHeaderView :: CC.Crypto crypto => BHeader crypto -> BHeaderView crypto
makeHeaderView :: BHeader crypto -> BHeaderView crypto
makeHeaderView BHeader crypto
bh =
  KeyHash 'BlockIssuer crypto
-> Natural
-> Int
-> Hash crypto EraIndependentBlockBody
-> SlotNo
-> BHeaderView crypto
forall crypto.
KeyHash 'BlockIssuer crypto
-> Natural
-> Int
-> Hash crypto EraIndependentBlockBody
-> SlotNo
-> BHeaderView crypto
BHeaderView
    (VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey (VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto)
-> (BHBody crypto -> VKey 'BlockIssuer crypto)
-> BHBody crypto
-> KeyHash 'BlockIssuer crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody crypto -> VKey 'BlockIssuer crypto
forall crypto. BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk (BHBody crypto -> KeyHash 'BlockIssuer crypto)
-> BHBody crypto -> KeyHash 'BlockIssuer crypto
forall a b. (a -> b) -> a -> b
$ BHBody crypto
bhb)
    (BHBody crypto -> Natural
forall crypto. BHBody crypto -> Natural
bsize (BHBody crypto -> Natural) -> BHBody crypto -> Natural
forall a b. (a -> b) -> a -> b
$ BHBody crypto
bhb)
    (BHeader crypto -> Int
forall crypto. BHeader crypto -> Int
bHeaderSize BHeader crypto
bh)
    (BHBody crypto -> Hash crypto EraIndependentBlockBody
forall crypto. BHBody crypto -> Hash crypto EraIndependentBlockBody
bhash BHBody crypto
bhb)
    (BHBody crypto -> SlotNo
forall crypto. BHBody crypto -> SlotNo
bheaderSlotNo BHBody crypto
bhb)
  where
    bhb :: BHBody crypto
bhb = BHeader crypto -> BHBody crypto
forall crypto. BHeader crypto -> BHBody crypto
bHeaderBody' BHeader crypto
bh