{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Cardano.Protocol.TPraos.BHeader (
  HashHeader (..),
  PrevHash (..),
  BHeader (BHeader, ..),
  BHeaderRaw (..),
  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.BaseTypes.NonZero (nonZero, (%.))
import Cardano.Ledger.Binary (
  Case (..),
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  TokenType (TypeNull),
  decodeNull,
  decodeRecordNamed,
  encodeListLen,
  encodeNull,
  encodedVerKeyVRFSizeExpr,
  listLenInt,
  peekTokenType,
  runByteBuilder,
  serialize',
  szCases,
  withWordSize,
 )
import Cardano.Ledger.Binary.Crypto
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (
  EraIndependentBlockBody,
  EraIndependentBlockHeader,
  HASH,
  Hash,
  HashAnnotated (..),
  KeyHash,
  KeyRole (..),
  SafeToHash,
  extractHash,
  hashKey,
  originalBytesSize,
 )
import Cardano.Ledger.Keys (VKey)
import Cardano.Ledger.MemoBytes (
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  getMemoRawType,
  getMemoSafeHash,
  mkMemoized,
 )
import Cardano.Ledger.NonIntegral (CompareResult (..), taylorExpCmp)
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Protocol.Crypto
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 Data.Typeable
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

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

deriving newtype instance EncCBOR HashHeader

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

instance NoThunks PrevHash

instance EncCBOR PrevHash where
  encCBOR :: PrevHash -> Encoding
encCBOR PrevHash
GenesisHash = Encoding
encodeNull
  encCBOR (BlockHash HashHeader
h) = forall a. EncCBOR a => a -> Encoding
encCBOR HashHeader
h
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy PrevHash -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy PrevHash
_ =
    [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
p)
      ]
    where
      p :: Proxy HashHeader
p = forall {k} (t :: k). Proxy t
Proxy :: Proxy HashHeader

instance DecCBOR PrevHash where
  decCBOR :: forall s. Decoder s PrevHash
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 PrevHash
GenesisHash
      TokenType
_ -> HashHeader -> PrevHash
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 DecCBOR HashHeader

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
bheaderPrev :: !PrevHash
  -- ^ Hash of the previous block header
  , forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk :: !(VKey 'BlockIssuer)
  -- ^ verification key of block issuer
  , forall c. BHBody c -> VerKeyVRF (VRF c)
bheaderVrfVk :: !(VRF.VerKeyVRF (VRF c))
  -- ^ VRF verification key for block issuer
  , forall c. BHBody c -> CertifiedVRF (VRF c) Nonce
bheaderEta :: !(VRF.CertifiedVRF (VRF c) Nonce)
  -- ^ block nonce
  , forall c. BHBody c -> CertifiedVRF (VRF c) Natural
bheaderL :: !(VRF.CertifiedVRF (VRF c) Natural)
  -- ^ leader election value
  , forall c. BHBody c -> Word32
bsize :: !Word32
  -- ^ Size of the block body
  , forall c. BHBody c -> Hash HASH EraIndependentBlockBody
bhash :: !(Hash HASH 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
bheaderPrev BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF (forall c. BHBody c -> VerKeyVRF (VRF c)
bheaderVrfVk BHBody c
bhBody)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall c. BHBody c -> CertifiedVRF (VRF 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 (VRF 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 HASH 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
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
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 (VRF 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 (VRF 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 (VRF 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 HASH 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
bheaderPrev <- forall a s. DecCBOR a => Decoder s a
decCBOR
    VKey 'BlockIssuer
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 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
bheaderPrev :: PrevHash
bheaderPrev :: PrevHash
bheaderPrev
        , VKey 'BlockIssuer
bheaderVk :: VKey 'BlockIssuer
bheaderVk :: VKey 'BlockIssuer
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 EraIndependentBlockBody
bhash :: Hash HASH EraIndependentBlockBody
bhash :: Hash HASH 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 BHeaderRaw c = BHeaderRaw
  { forall c. BHeaderRaw c -> BHBody c
bhrBody :: !(BHBody c)
  , forall c. BHeaderRaw c -> SignedKES (KES c) (BHBody c)
bhrSignature :: !(KES.SignedKES (KES c) (BHBody c))
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (BHeaderRaw c) x -> BHeaderRaw c
forall c x. BHeaderRaw c -> Rep (BHeaderRaw c) x
$cto :: forall c x. Rep (BHeaderRaw c) x -> BHeaderRaw c
$cfrom :: forall c x. BHeaderRaw c -> Rep (BHeaderRaw c) x
Generic, BHeaderRaw c -> BHeaderRaw c -> Bool
forall c. Crypto c => BHeaderRaw c -> BHeaderRaw c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BHeaderRaw c -> BHeaderRaw c -> Bool
$c/= :: forall c. Crypto c => BHeaderRaw c -> BHeaderRaw c -> Bool
== :: BHeaderRaw c -> BHeaderRaw c -> Bool
$c== :: forall c. Crypto c => BHeaderRaw c -> BHeaderRaw c -> Bool
Eq, Int -> BHeaderRaw c -> ShowS
forall c. Crypto c => Int -> BHeaderRaw c -> ShowS
forall c. Crypto c => [BHeaderRaw c] -> ShowS
forall c. Crypto c => BHeaderRaw c -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BHeaderRaw c] -> ShowS
$cshowList :: forall c. Crypto c => [BHeaderRaw c] -> ShowS
show :: BHeaderRaw c -> [Char]
$cshow :: forall c. Crypto c => BHeaderRaw c -> [Char]
showsPrec :: Int -> BHeaderRaw c -> ShowS
$cshowsPrec :: forall c. Crypto c => Int -> BHeaderRaw c -> ShowS
Show)

instance Crypto c => NoThunks (BHeaderRaw c)

instance Crypto c => EncCBOR (BHeaderRaw c) where
  encCBOR :: BHeaderRaw c -> Encoding
encCBOR bh :: BHeaderRaw c
bh@(BHeaderRaw BHBody c
_ SignedKES (KES c) (BHBody c)
_) =
    let BHeaderRaw {SignedKES (KES c) (BHBody c)
BHBody c
bhrSignature :: SignedKES (KES c) (BHBody c)
bhrBody :: BHBody c
bhrSignature :: forall c. BHeaderRaw c -> SignedKES (KES c) (BHBody c)
bhrBody :: forall c. BHeaderRaw c -> BHBody c
..} = BHeaderRaw c
bh
     in Word -> Encoding
encodeListLen Word
2
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR BHBody c
bhrBody
          forall a. Semigroup a => a -> a -> a
<> forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES SignedKES (KES c) (BHBody c)
bhrSignature

instance Crypto c => DecCBOR (BHeaderRaw c) where
  decCBOR :: forall s. Decoder s (BHeaderRaw c)
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BHeaderRaw" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$
      forall c. BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c
BHeaderRaw 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 v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES

newtype BHeader c = BHeaderConstr (MemoBytes (BHeaderRaw c))
  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 newtype (BHeader c -> BHeader c -> Bool
forall c. Crypto c => BHeader c -> BHeader c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BHeader c -> BHeader c -> Bool
$c/= :: forall c. Crypto c => BHeader c -> BHeader c -> Bool
== :: BHeader c -> BHeader c -> Bool
$c== :: forall c. Crypto c => BHeader c -> BHeader c -> Bool
Eq, Int -> BHeader c -> ShowS
[BHeader c] -> ShowS
BHeader c -> [Char]
forall c. Crypto c => Int -> BHeader c -> ShowS
forall c. Crypto c => [BHeader c] -> ShowS
forall c. Crypto c => BHeader c -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BHeader c] -> ShowS
$cshowList :: forall c. Crypto c => [BHeader c] -> ShowS
show :: BHeader c -> [Char]
$cshow :: forall c. Crypto c => BHeader c -> [Char]
showsPrec :: Int -> BHeader c -> ShowS
$cshowsPrec :: forall c. Crypto c => Int -> BHeader c -> ShowS
Show, Context -> BHeader c -> IO (Maybe ThunkInfo)
Proxy (BHeader c) -> [Char]
forall c. Crypto c => Context -> BHeader c -> IO (Maybe ThunkInfo)
forall c. Crypto c => Proxy (BHeader c) -> [Char]
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
showTypeOf :: Proxy (BHeader c) -> [Char]
$cshowTypeOf :: forall c. Crypto c => Proxy (BHeader c) -> [Char]
wNoThunks :: Context -> BHeader c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Crypto c => Context -> BHeader c -> IO (Maybe ThunkInfo)
noThunks :: Context -> BHeader c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Crypto c => Context -> BHeader c -> IO (Maybe ThunkInfo)
NoThunks, BHeader c -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [BHeader c] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHeader c) -> Size
forall {c}. Typeable c => Typeable (BHeader c)
forall c. Typeable c => BHeader c -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall c.
Typeable c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [BHeader c] -> Size
forall c.
Typeable c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHeader c) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [BHeader c] -> Size
$cencodedListSizeExpr :: forall c.
Typeable c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [BHeader c] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHeader c) -> Size
$cencodedSizeExpr :: forall c.
Typeable c =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (BHeader c) -> Size
toCBOR :: BHeader c -> Encoding
$ctoCBOR :: forall c. Typeable c => BHeader c -> Encoding
Plain.ToCBOR, Proxy (BHeader c) -> Text
forall s. Decoder s (BHeader c)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (BHeader c) -> Decoder s ()
forall {c}. Crypto c => Typeable (BHeader c)
forall c. Crypto c => Proxy (BHeader c) -> Text
forall c s. Crypto c => Decoder s (BHeader c)
forall c s. Crypto c => Proxy (BHeader c) -> Decoder s ()
label :: Proxy (BHeader c) -> Text
$clabel :: forall c. Crypto c => Proxy (BHeader c) -> Text
dropCBOR :: forall s. Proxy (BHeader c) -> Decoder s ()
$cdropCBOR :: forall c s. Crypto c => Proxy (BHeader c) -> Decoder s ()
decCBOR :: forall s. Decoder s (BHeader c)
$cdecCBOR :: forall c s. Crypto c => Decoder s (BHeader c)
DecCBOR, BHeader c -> Int
BHeader c -> ByteString
forall i. Proxy i -> BHeader c -> SafeHash i
forall c. BHeader c -> Int
forall c. BHeader c -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall c i. Proxy i -> BHeader c -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> BHeader c -> SafeHash i
$cmakeHashWithExplicitProxys :: forall c i. Proxy i -> BHeader c -> SafeHash i
originalBytesSize :: BHeader c -> Int
$coriginalBytesSize :: forall c. BHeader c -> Int
originalBytes :: BHeader c -> ByteString
$coriginalBytes :: forall c. BHeader c -> ByteString
SafeToHash)

type instance MemoHashIndex (BHeaderRaw c) = EraIndependentBlockHeader
instance HashAnnotated (BHeader c) EraIndependentBlockHeader where
  hashAnnotated :: BHeader c -> SafeHash EraIndependentBlockHeader
hashAnnotated = forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

instance Crypto c => EncCBOR (BHeader c)

instance Memoized (BHeader c) where
  type RawType (BHeader c) = BHeaderRaw c

pattern BHeader ::
  Crypto c =>
  BHBody c ->
  KES.SignedKES (KES c) (BHBody c) ->
  BHeader c
pattern $bBHeader :: forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
$mBHeader :: forall {r} {c}.
Crypto c =>
BHeader c
-> (BHBody c -> SignedKES (KES c) (BHBody c) -> r)
-> ((# #) -> r)
-> r
BHeader bHeaderBody' bHeaderSig' <-
  (getMemoRawType -> BHeaderRaw bHeaderBody' bHeaderSig')
  where
    BHeader BHBody c
bHeaderBody SignedKES (KES c) (BHBody c)
bHeaderSig =
      forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized (ProtVer -> Version
pvMajor (forall c. BHBody c -> ProtVer
bprotver BHBody c
bHeaderBody)) forall a b. (a -> b) -> a -> b
$ forall c. BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c
BHeaderRaw BHBody c
bHeaderBody SignedKES (KES c) (BHBody c)
bHeaderSig
{-# COMPLETE BHeader #-}

-- | Hash a given block header
bhHash :: BHeader c -> HashHeader
bhHash :: forall c. BHeader c -> HashHeader
bhHash = Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. SafeHash i -> Hash HASH i
extractHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated

-- | HashHeader to Nonce
hashHeaderToNonce :: HashHeader -> Nonce
hashHeaderToNonce :: HashHeader -> Nonce
hashHeaderToNonce (HashHeader Hash HASH EraIndependentBlockHeader
h) = Hash HASH Nonce -> Nonce
Nonce forall a b. (a -> b) -> a -> b
$ forall h a b. Hash h a -> Hash h b
Hash.castHash Hash HASH EraIndependentBlockHeader
h

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

{-# DEPRECATED bHeaderSize "In favor of `originalBytesSize`" #-}
bHeaderSize :: BHeader c -> Int
bHeaderSize :: forall c. BHeader c -> Int
bHeaderSize = forall t. SafeToHash t => t -> Int
originalBytesSize

bhbody ::
  Crypto c =>
  BHeader c ->
  BHBody c
bhbody :: forall c. Crypto c => BHeader c -> BHBody c
bhbody (BHeader BHBody c
b SignedKES (KES 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 =
      case forall a. HasZero a => a -> Maybe (NonZero a)
nonZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Natural
certNatMax forall a. Num a => a -> a -> a
- Natural
certNat of
        Just NonZero Integer
d -> forall a. Fractional a => Rational -> a
fromRational (forall a. Integral a => a -> Integer
toInteger Natural
certNatMax forall a. Integral a => a -> NonZero a -> Ratio a
%. NonZero Integer
d)
        Maybe (NonZero Integer)
Nothing -> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural @FixedPoint Natural
certNatMax
    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 HASH 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 HASH 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 HASH 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 HASH Nonce
h -> ByteString -> Builder
BS.byteStringCopy (forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash HASH Nonce
h)
         )

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

instance NoThunks LastAppliedBlock

instance NFData LastAppliedBlock

instance EncCBOR LastAppliedBlock where
  encCBOR :: LastAppliedBlock -> Encoding
encCBOR (LastAppliedBlock BlockNo
b SlotNo
s HashHeader
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
h

instance DecCBOR LastAppliedBlock where
  decCBOR :: forall s. Decoder s LastAppliedBlock
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)
      ( BlockNo -> SlotNo -> HashHeader -> LastAppliedBlock
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 -> PrevHash
lastAppliedHash :: WithOrigin LastAppliedBlock -> PrevHash
lastAppliedHash WithOrigin LastAppliedBlock
Origin = PrevHash
GenesisHash
lastAppliedHash (At LastAppliedBlock
lab) = HashHeader -> PrevHash
BlockHash forall a b. (a -> b) -> a -> b
$ LastAppliedBlock -> HashHeader
labHash LastAppliedBlock
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 (VRF c) Nonce
bheaderEta

makeHeaderView :: Crypto c => BHeader c -> BHeaderView
makeHeaderView :: forall c. Crypto c => BHeader c -> BHeaderView
makeHeaderView bh :: BHeader c
bh@(BHeader BHBody c
bhb SignedKES (KES c) (BHBody c)
_) =
  KeyHash 'BlockIssuer
-> Word32
-> Int
-> Hash HASH EraIndependentBlockBody
-> SlotNo
-> BHeaderView
BHeaderView
    (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk forall a b. (a -> b) -> a -> b
$ BHBody c
bhb)
    (forall c. BHBody c -> Word32
bsize BHBody c
bhb)
    (forall t. SafeToHash t => t -> Int
originalBytesSize BHeader c
bh)
    (forall c. BHBody c -> Hash HASH EraIndependentBlockBody
bhash BHBody c
bhb)
    (forall c. BHBody c -> SlotNo
bheaderSlotNo BHBody c
bhb)