{-# 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 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 Cardano.Ledger.Binary (
  Annotator (..),
  Case (..),
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  TokenType (TypeNull),
  annotatorSlice,
  decodeNull,
  decodeRecordNamed,
  encodeListLen,
  encodeNull,
  encodedSigKESSizeExpr,
  encodedVerKeyVRFSizeExpr,
  hashEncCBOR,
  listLenInt,
  peekTokenType,
  runByteBuilder,
  serialize',
  szCases,
  withWordSize,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Crypto (Crypto)
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.Slot (BlockNo (..), SlotNo (..))
import Cardano.Protocol.TPraos.OCert (OCert (..))
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
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 (Word32, Word64)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Numeric.Natural (Natural)

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

deriving newtype instance Crypto c => EncCBOR (HashHeader c)

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

instance Crypto c => NoThunks (PrevHash c)

instance
  Crypto c =>
  EncCBOR (PrevHash c)
  where
  encCBOR :: PrevHash c -> Encoding
encCBOR PrevHash c
GenesisHash = Encoding
encodeNull
  encCBOR (BlockHash HashHeader c
h) = forall a. EncCBOR a => a -> Encoding
encCBOR HashHeader c
h
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PrevHash c) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (PrevHash c)
_ =
    [Case Size] -> Size
szCases
      [ forall t. Text -> t -> Case t
Case Text
"GenesisHash" Size
1
      , forall t. Text -> t -> Case t
Case Text
"BlockHash" (forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (HashHeader c)
p)
      ]
    where
      p :: Proxy (HashHeader c)
p = forall {k} (t :: k). Proxy t
Proxy :: Proxy (HashHeader c)

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

deriving newtype instance Crypto c => DecCBOR (HashHeader c)

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

deriving instance Crypto c => Show (BHBody c)

deriving instance Crypto c => Eq (BHBody c)

instance
  Crypto c =>
  SignableRepresentation (BHBody c)
  where
  getSignableRepresentation :: BHBody c -> ByteString
getSignableRepresentation BHBody c
bh = forall a. EncCBOR a => Version -> a -> ByteString
serialize' (ProtVer -> Version
pvMajor (forall c. BHBody c -> ProtVer
bprotver BHBody c
bh)) BHBody c
bh

instance
  Crypto c =>
  NoThunks (BHBody c)

instance
  Crypto c =>
  EncCBOR (BHBody c)
  where
  encCBOR :: BHBody c -> Encoding
encCBOR BHBody c
bhBody =
    Word -> Encoding
encodeListLen (Word
9 forall a. Num a => a -> a -> a
+ forall a. EncCBORGroup a => a -> Word
listLen OCert c
oc forall a. Num a => a -> a -> a
+ forall a. EncCBORGroup a => a -> Word
listLen ProtVer
pv)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> BlockNo
bheaderBlockNo BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> SlotNo
bheaderSlotNo BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> PrevHash c
bheaderPrev BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> VKey 'BlockIssuer c
bheaderVk BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF (forall c. BHBody c -> VerKeyVRF c
bheaderVrfVk BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> CertifiedVRF c Nonce
bheaderEta BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> CertifiedVRF c Natural
bheaderL BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> Word32
bsize BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> Hash c EraIndependentBlockBody
bhash BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBORGroup a => a -> Encoding
encCBORGroup OCert c
oc
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBORGroup a => a -> Encoding
encCBORGroup ProtVer
pv
    where
      oc :: OCert c
oc = forall c. BHBody c -> OCert c
bheaderOCert BHBody c
bhBody
      pv :: ProtVer
pv = forall c. BHBody c -> ProtVer
bprotver BHBody c
bhBody

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

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

data BHeader c = BHeader'
  { forall c. BHeader c -> BHBody c
bHeaderBody' :: !(BHBody c)
  , forall c. BHeader c -> SignedKES c (BHBody c)
bHeaderSig' :: !(SignedKES c (BHBody c))
  , forall c. BHeader c -> ByteString
bHeaderBytes :: BS.ByteString -- Lazy on purpose. Constructed on demand
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (BHeader c) x -> BHeader c
forall c x. BHeader c -> Rep (BHeader c) x
$cto :: forall c x. Rep (BHeader c) x -> BHeader c
$cfrom :: forall c x. BHeader c -> Rep (BHeader c) x
Generic)

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

deriving instance Crypto c => Eq (BHeader c)

deriving instance Crypto c => Show (BHeader c)

pattern BHeader ::
  Crypto c =>
  BHBody c ->
  SignedKES c (BHBody c) ->
  BHeader c
pattern $bBHeader :: forall c.
Crypto c =>
BHBody c -> SignedKES c (BHBody c) -> BHeader c
$mBHeader :: forall {r} {c}.
Crypto c =>
BHeader c
-> (BHBody c -> SignedKES c (BHBody c) -> r) -> ((# #) -> r) -> r
BHeader bHeaderBody' bHeaderSig' <-
  BHeader' {bHeaderBody', bHeaderSig'}
  where
    BHeader BHBody c
body SignedKES c (BHBody c)
sig =
      let mkBytes :: BHBody c -> SignedKES v a -> ByteString
mkBytes BHBody c
bhBody SignedKES v a
kESig =
            forall a. EncCBOR a => Version -> a -> ByteString
serialize' (ProtVer -> Version
pvMajor (forall c. BHBody c -> ProtVer
bprotver BHBody c
bhBody)) forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen Word
2
                forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR BHBody c
bhBody
                forall a. Semigroup a => a -> a -> a
<> forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES SignedKES v a
kESig
       in forall c.
BHBody c -> SignedKES c (BHBody c) -> ByteString -> BHeader c
BHeader' BHBody c
body SignedKES c (BHBody c)
sig (forall {c} {v} {a}.
(Crypto c, KESAlgorithm v) =>
BHBody c -> SignedKES v a -> ByteString
mkBytes BHBody c
body SignedKES c (BHBody c)
sig)

{-# COMPLETE BHeader #-}

instance Crypto c => Plain.ToCBOR (BHeader c) where
  toCBOR :: BHeader c -> Encoding
toCBOR (BHeader' BHBody c
_ SignedKES c (BHBody c)
_ ByteString
bytes) = ByteString -> Encoding
Plain.encodePreEncoded ByteString
bytes

instance Crypto c => EncCBOR (BHeader c) where
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (BHeader c) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (BHeader c)
proxy =
    Size
1
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall c. BHeader c -> BHBody c
bHeaderBody' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHeader c)
proxy)
      forall a. Num a => a -> a -> a
+ forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr (forall v a. SignedKES v a -> SigKES v
KES.getSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. BHeader c -> SignedKES c (BHBody c)
bHeaderSig' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (BHeader c)
proxy)

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

-- | Hash a given block header
bhHash ::
  Crypto c =>
  BHeader c ->
  HashHeader c
bhHash :: forall c. Crypto c => BHeader c -> HashHeader c
bhHash BHeader c
bh = forall c. Hash c EraIndependentBlockHeader -> HashHeader c
HashHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. Hash h a -> Hash h b
Hash.castHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
(HashAlgorithm h, EncCBOR a) =>
Version -> a -> Hash h a
hashEncCBOR Version
version forall a b. (a -> b) -> a -> b
$ BHeader c
bh
  where
    version :: Version
version = ProtVer -> Version
pvMajor (forall c. BHBody c -> ProtVer
bprotver (forall c. BHeader c -> BHBody c
bHeaderBody' BHeader c
bh))

-- | 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 c -> Nonce
hashHeaderToNonce :: forall c. HashHeader c -> Nonce
hashHeaderToNonce (HashHeader Hash c EraIndependentBlockHeader
h) = case 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 (forall h a b. Hash h a -> Hash h b
Hash.castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith forall a. a -> a
id ByteString
bytes))
  Just Hash Blake2b_256 Nonce
hash -> Hash Blake2b_256 Nonce -> Nonce
Nonce forall a b. (a -> b) -> a -> b
$! Hash Blake2b_256 Nonce
hash
  where
    bytes :: ByteString
bytes = forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash c EraIndependentBlockHeader
h

prevHashToNonce ::
  PrevHash c ->
  Nonce
prevHashToNonce :: forall c. PrevHash c -> Nonce
prevHashToNonce = \case
  PrevHash c
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 c
ph -> forall c. HashHeader c -> Nonce
hashHeaderToNonce HashHeader c
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 :: Crypto c => BHBody c -> KeyHash 'BlockIssuer c
issuerIDfromBHBody :: forall c. Crypto c => BHBody c -> KeyHash 'BlockIssuer c
issuerIDfromBHBody = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. BHBody c -> VKey 'BlockIssuer c
bheaderVk

bHeaderSize :: forall c. BHeader c -> Int
bHeaderSize :: forall c. BHeader c -> Int
bHeaderSize = ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. BHeader c -> ByteString
bHeaderBytes

bhbody ::
  Crypto c =>
  BHeader c ->
  BHBody c
bhbody :: forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader BHBody c
b SignedKES c (BHBody c)
_) = BHBody c
b

hBbsize :: BHBody c -> Word32
hBbsize :: forall c. BHBody c -> Word32
hBbsize = forall c. BHBody c -> Word32
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 forall a. Ord a => a -> a -> Bool
<= Natural
maxVal
    then Natural -> Natural -> BoundedNatural
UnsafeBoundedNatural Natural
maxVal Natural
val
    else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Natural
val forall a. Semigroup a => a -> a -> a
<> [Char]
" is greater than max value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
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 :: forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue OutputVRF v
certVRF Rational
σ ActiveSlotCoeff
f =
  BoundedNatural -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderNatValue (Natural -> Natural -> BoundedNatural
assertBoundedNatural Natural
certNatMax (forall v. OutputVRF v -> Natural
VRF.getOutputVRFNatural OutputVRF v
certVRF)) Rational
σ ActiveSlotCoeff
f
  where
    certNatMax :: Natural
    certNatMax :: Natural
certNatMax = (Natural
2 :: Natural) forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
8 forall a. Num a => a -> a -> a
* 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 forall a. Eq a => a -> a -> Bool
== 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 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 = forall a. Fractional a => Rational -> a
fromRational (forall a. Integral a => a -> Integer
toInteger Natural
certNatMax forall a. Integral a => a -> a -> Ratio a
% forall a. Integral a => a -> Integer
toInteger (Natural
certNatMax forall a. Num a => a -> a -> a
- Natural
certNat))
    x :: FixedPoint
x = -forall a. Fractional a => Rational -> a
fromRational Rational
σ 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( case Nonce
ucNonce of
          Nonce
NeutralNonce -> forall a. a -> a
id
          Nonce Hash Blake2b_256 Nonce
h -> forall h a. Hash h a -> Hash h a -> Hash h a
Hash.xor (forall h a b. Hash h a -> Hash h b
Hash.castHash Hash Blake2b_256 Nonce
h)
      )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. Hash h a -> Hash h b
Hash.castHash
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith forall a. a -> a
id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> ByteString
runByteBuilder (Int
8 forall a. Num a => a -> a -> a
+ Int
32)
    forall a b. (a -> b) -> a -> b
$ Word64 -> Builder
BS.word64BE Word64
slot
      forall a. Semigroup a => a -> a -> a
<> ( case Nonce
eNonce of
            Nonce
NeutralNonce -> forall a. Monoid a => a
mempty
            Nonce Hash Blake2b_256 Nonce
h -> ByteString -> Builder
BS.byteStringCopy (forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash Blake2b_256 Nonce
h)
         )

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

instance Crypto c => NoThunks (LastAppliedBlock c)

instance NFData (LastAppliedBlock c)

instance Crypto c => EncCBOR (LastAppliedBlock c) where
  encCBOR :: LastAppliedBlock c -> Encoding
encCBOR (LastAppliedBlock BlockNo
b SlotNo
s HashHeader c
h) =
    Word -> Encoding
encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR BlockNo
b forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR SlotNo
s forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR HashHeader c
h

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

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

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

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