{-# 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 (
  Annotator,
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  TokenType (TypeNull),
  decodeNull,
  decodeRecordNamed,
  encodeListLen,
  encodeNull,
  listLenInt,
  peekTokenType,
  runByteBuilder,
  serialize',
 )
import Cardano.Ledger.Binary.Crypto
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (
  EraIndependentBlockBody,
  EraIndependentBlockHeader,
  HASH,
  Hash,
  HashAnnotated (..),
  HashHeader (..),
  KeyHash,
  KeyRole (..),
  SafeToHash,
  extractHash,
  hashKey,
  originalBytesSize,
 )
import Cardano.Ledger.Keys (VKey)
import Cardano.Ledger.MemoBytes (
  Mem,
  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.Word (Word32)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

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

instance NoThunks PrevHash

instance EncCBOR PrevHash where
  encCBOR :: PrevHash -> Encoding
encCBOR PrevHash
GenesisHash = Encoding
encodeNull
  encCBOR (BlockHash HashHeader
h) = HashHeader -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR HashHeader
h

instance DecCBOR PrevHash where
  decCBOR :: forall s. Decoder s PrevHash
decCBOR = do
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s PrevHash) -> Decoder s PrevHash
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
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 -> Decoder s PrevHash
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash
GenesisHash
      TokenType
_ -> HashHeader -> PrevHash
BlockHash (HashHeader -> PrevHash)
-> Decoder s HashHeader -> Decoder s PrevHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s HashHeader
forall s. Decoder s HashHeader
forall a s. DecCBOR a => Decoder s a
decCBOR

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 Blake2b_256 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 x. BHBody c -> Rep (BHBody c) x)
-> (forall x. Rep (BHBody c) x -> BHBody c) -> Generic (BHBody c)
forall x. Rep (BHBody c) x -> BHBody c
forall x. BHBody c -> Rep (BHBody c) x
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
$cfrom :: forall c x. BHBody c -> Rep (BHBody c) x
from :: forall x. BHBody c -> Rep (BHBody c) x
$cto :: forall c x. Rep (BHBody c) x -> BHBody c
to :: forall x. Rep (BHBody c) x -> BHBody c
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 = Version -> BHBody c -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' (ProtVer -> Version
pvMajor (BHBody c -> ProtVer
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 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ OCert c -> Word
forall a. EncCBORGroup a => a -> Word
listLen OCert c
oc Word -> Word -> Word
forall a. Num a => a -> a -> a
+ ProtVer -> Word
forall a. EncCBORGroup a => a -> Word
listLen ProtVer
pv)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlockNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> BlockNo
forall c. BHBody c -> BlockNo
bheaderBlockNo BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> SlotNo
forall c. BHBody c -> SlotNo
bheaderSlotNo BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PrevHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> PrevHash
forall c. BHBody c -> PrevHash
bheaderPrev BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VKey 'BlockIssuer -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> VKey 'BlockIssuer
forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerKeyVRF (VRF c) -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF (BHBody c -> VerKeyVRF (VRF c)
forall c. BHBody c -> VerKeyVRF (VRF c)
bheaderVrfVk BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertifiedVRF (VRF c) Nonce -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> CertifiedVRF (VRF c) Nonce
forall c. BHBody c -> CertifiedVRF (VRF c) Nonce
bheaderEta BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertifiedVRF (VRF c) Natural -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> CertifiedVRF (VRF c) Natural
forall c. BHBody c -> CertifiedVRF (VRF c) Natural
bheaderL BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> Word32
forall c. BHBody c -> Word32
bsize BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash Blake2b_256 EraIndependentBlockBody -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (BHBody c -> Hash Blake2b_256 EraIndependentBlockBody
forall c. BHBody c -> Hash Blake2b_256 EraIndependentBlockBody
bhash BHBody c
bhBody)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> OCert c -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup OCert c
oc
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtVer -> Encoding
forall a. EncCBORGroup a => a -> Encoding
encCBORGroup ProtVer
pv
    where
      oc :: OCert c
oc = BHBody c -> OCert c
forall c. BHBody c -> OCert c
bheaderOCert BHBody c
bhBody
      pv :: ProtVer
pv = BHBody c -> ProtVer
forall c. BHBody c -> ProtVer
bprotver BHBody c
bhBody

instance Crypto c => DecCBOR (BHBody c) where
  decCBOR :: forall s. Decoder s (BHBody c)
decCBOR = Text
-> (BHBody c -> Int)
-> Decoder s (BHBody c)
-> Decoder s (BHBody c)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BHBody" BHBody c -> Int
forall {c}. Crypto c => BHBody c -> Int
bhBodySize (Decoder s (BHBody c) -> Decoder s (BHBody c))
-> Decoder s (BHBody c) -> Decoder s (BHBody c)
forall a b. (a -> b) -> a -> b
$ do
    BlockNo
bheaderBlockNo <- Decoder s BlockNo
forall s. Decoder s BlockNo
forall a s. DecCBOR a => Decoder s a
decCBOR
    SlotNo
bheaderSlotNo <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
    PrevHash
bheaderPrev <- Decoder s PrevHash
forall s. Decoder s PrevHash
forall a s. DecCBOR a => Decoder s a
decCBOR
    VKey 'BlockIssuer
bheaderVk <- Decoder s (VKey 'BlockIssuer)
forall s. Decoder s (VKey 'BlockIssuer)
forall a s. DecCBOR a => Decoder s a
decCBOR
    VerKeyVRF (VRF c)
bheaderVrfVk <- Decoder s (VerKeyVRF (VRF c))
forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF
    CertifiedVRF (VRF c) Nonce
bheaderEta <- Decoder s (CertifiedVRF (VRF c) Nonce)
forall s. Decoder s (CertifiedVRF (VRF c) Nonce)
forall a s. DecCBOR a => Decoder s a
decCBOR
    CertifiedVRF (VRF c) Natural
bheaderL <- Decoder s (CertifiedVRF (VRF c) Natural)
forall s. Decoder s (CertifiedVRF (VRF c) Natural)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word32
bsize <- Decoder s Word32
forall s. Decoder s Word32
forall a s. DecCBOR a => Decoder s a
decCBOR
    Hash Blake2b_256 EraIndependentBlockBody
bhash <- Decoder s (Hash Blake2b_256 EraIndependentBlockBody)
forall s. Decoder s (Hash Blake2b_256 EraIndependentBlockBody)
forall a s. DecCBOR a => Decoder s a
decCBOR
    OCert c
bheaderOCert <- Decoder s (OCert c)
forall s. Decoder s (OCert c)
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup
    ProtVer
bprotver <- Decoder s ProtVer
forall s. Decoder s ProtVer
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup
    BHBody c -> Decoder s (BHBody c)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BHBody c -> Decoder s (BHBody c))
-> BHBody c -> Decoder s (BHBody c)
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 Blake2b_256 EraIndependentBlockBody
bhash :: Hash Blake2b_256 EraIndependentBlockBody
bhash :: Hash Blake2b_256 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OCert c -> Int
forall a. EncCBORGroup a => a -> Int
listLenInt (BHBody c -> OCert c
forall c. BHBody c -> OCert c
bheaderOCert BHBody c
body) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ProtVer -> Int
forall a. EncCBORGroup a => a -> Int
listLenInt (BHBody c -> ProtVer
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 x. BHeaderRaw c -> Rep (BHeaderRaw c) x)
-> (forall x. Rep (BHeaderRaw c) x -> BHeaderRaw c)
-> Generic (BHeaderRaw c)
forall x. Rep (BHeaderRaw c) x -> BHeaderRaw c
forall x. BHeaderRaw c -> Rep (BHeaderRaw c) x
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
$cfrom :: forall c x. BHeaderRaw c -> Rep (BHeaderRaw c) x
from :: forall x. BHeaderRaw c -> Rep (BHeaderRaw c) x
$cto :: forall c x. Rep (BHeaderRaw c) x -> BHeaderRaw c
to :: forall x. Rep (BHeaderRaw c) x -> BHeaderRaw c
Generic, BHeaderRaw c -> BHeaderRaw c -> Bool
(BHeaderRaw c -> BHeaderRaw c -> Bool)
-> (BHeaderRaw c -> BHeaderRaw c -> Bool) -> Eq (BHeaderRaw c)
forall c. Crypto c => BHeaderRaw c -> BHeaderRaw c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: BHeaderRaw c -> BHeaderRaw c -> Bool
Eq, Int -> BHeaderRaw c -> ShowS
[BHeaderRaw c] -> ShowS
BHeaderRaw c -> [Char]
(Int -> BHeaderRaw c -> ShowS)
-> (BHeaderRaw c -> [Char])
-> ([BHeaderRaw c] -> ShowS)
-> Show (BHeaderRaw c)
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
$cshowsPrec :: forall c. Crypto c => Int -> BHeaderRaw c -> ShowS
showsPrec :: Int -> BHeaderRaw c -> ShowS
$cshow :: forall c. Crypto c => BHeaderRaw c -> [Char]
show :: BHeaderRaw c -> [Char]
$cshowList :: forall c. Crypto c => [BHeaderRaw c] -> ShowS
showList :: [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
bhrBody :: forall c. BHeaderRaw c -> BHBody c
bhrSignature :: forall c. BHeaderRaw c -> SignedKES (KES c) (BHBody c)
bhrBody :: BHBody c
bhrSignature :: SignedKES (KES c) (BHBody c)
..} = BHeaderRaw c
bh
     in Word -> Encoding
encodeListLen Word
2
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BHBody c -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR BHBody c
bhrBody
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedKES (KES c) (BHBody c) -> Encoding
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 =
    Text
-> (BHeaderRaw c -> Int)
-> Decoder s (BHeaderRaw c)
-> Decoder s (BHeaderRaw c)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"BHeaderRaw" (Int -> BHeaderRaw c -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (BHeaderRaw c) -> Decoder s (BHeaderRaw c))
-> Decoder s (BHeaderRaw c) -> Decoder s (BHeaderRaw c)
forall a b. (a -> b) -> a -> b
$
      BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c
forall c. BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c
BHeaderRaw (BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c)
-> Decoder s (BHBody c)
-> Decoder s (SignedKES (KES c) (BHBody c) -> BHeaderRaw c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (BHBody c)
forall s. Decoder s (BHBody c)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (SignedKES (KES c) (BHBody c) -> BHeaderRaw c)
-> Decoder s (SignedKES (KES c) (BHBody c))
-> Decoder s (BHeaderRaw c)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (SignedKES (KES c) (BHBody c))
forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES

instance Crypto c => DecCBOR (Annotator (BHeaderRaw c)) where
  decCBOR :: forall s. Decoder s (Annotator (BHeaderRaw c))
decCBOR = BHeaderRaw c -> Annotator (BHeaderRaw c)
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BHeaderRaw c -> Annotator (BHeaderRaw c))
-> Decoder s (BHeaderRaw c) -> Decoder s (Annotator (BHeaderRaw c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (BHeaderRaw c)
forall s. Decoder s (BHeaderRaw c)
forall a s. DecCBOR a => Decoder s a
decCBOR

newtype BHeader c = BHeaderConstr (MemoBytes (BHeaderRaw c))
  deriving ((forall x. BHeader c -> Rep (BHeader c) x)
-> (forall x. Rep (BHeader c) x -> BHeader c)
-> Generic (BHeader c)
forall x. Rep (BHeader c) x -> BHeader c
forall x. BHeader c -> Rep (BHeader c) x
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
$cfrom :: forall c x. BHeader c -> Rep (BHeader c) x
from :: forall x. BHeader c -> Rep (BHeader c) x
$cto :: forall c x. Rep (BHeader c) x -> BHeader c
to :: forall x. Rep (BHeader c) x -> BHeader c
Generic)
  deriving newtype (BHeader c -> BHeader c -> Bool
(BHeader c -> BHeader c -> Bool)
-> (BHeader c -> BHeader c -> Bool) -> Eq (BHeader c)
forall c. Crypto c => BHeader c -> BHeader c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: BHeader c -> BHeader c -> Bool
Eq, Int -> BHeader c -> ShowS
[BHeader c] -> ShowS
BHeader c -> [Char]
(Int -> BHeader c -> ShowS)
-> (BHeader c -> [Char])
-> ([BHeader c] -> ShowS)
-> Show (BHeader c)
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
$cshowsPrec :: forall c. Crypto c => Int -> BHeader c -> ShowS
showsPrec :: Int -> BHeader c -> ShowS
$cshow :: forall c. Crypto c => BHeader c -> [Char]
show :: BHeader c -> [Char]
$cshowList :: forall c. Crypto c => [BHeader c] -> ShowS
showList :: [BHeader c] -> ShowS
Show, Context -> BHeader c -> IO (Maybe ThunkInfo)
Proxy (BHeader c) -> [Char]
(Context -> BHeader c -> IO (Maybe ThunkInfo))
-> (Context -> BHeader c -> IO (Maybe ThunkInfo))
-> (Proxy (BHeader c) -> [Char])
-> NoThunks (BHeader c)
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
$cnoThunks :: forall c. Crypto c => Context -> BHeader c -> IO (Maybe ThunkInfo)
noThunks :: Context -> BHeader c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Crypto c => Context -> BHeader c -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BHeader c -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c. Crypto c => Proxy (BHeader c) -> [Char]
showTypeOf :: Proxy (BHeader c) -> [Char]
NoThunks, Typeable (BHeader c)
Typeable (BHeader c) =>
(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)
-> ToCBOR (BHeader c)
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
$ctoCBOR :: forall c. Typeable c => BHeader c -> Encoding
toCBOR :: BHeader c -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
Plain.ToCBOR, BHeader c -> Int
BHeader c -> ByteString
(BHeader c -> ByteString)
-> (BHeader c -> Int)
-> (forall i. Proxy i -> BHeader c -> SafeHash i)
-> SafeToHash (BHeader c)
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
$coriginalBytes :: forall c. BHeader c -> ByteString
originalBytes :: BHeader c -> ByteString
$coriginalBytesSize :: forall c. BHeader c -> Int
originalBytesSize :: BHeader c -> Int
$cmakeHashWithExplicitProxys :: forall c i. Proxy i -> BHeader c -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> BHeader c -> SafeHash i
SafeToHash)

type instance MemoHashIndex (BHeaderRaw c) = EraIndependentBlockHeader

instance HashAnnotated (BHeader c) EraIndependentBlockHeader where
  hashAnnotated :: BHeader c -> SafeHash EraIndependentBlockHeader
hashAnnotated = BHeader c -> SafeHash EraIndependentBlockHeader
BHeader c -> SafeHash (MemoHashIndex (RawType (BHeader c)))
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

deriving via
  Mem (BHeaderRaw c)
  instance
    Crypto c => DecCBOR (Annotator (BHeader c))

pattern BHeader ::
  Crypto c =>
  BHBody c ->
  KES.SignedKES (KES c) (BHBody c) ->
  BHeader c
pattern $mBHeader :: forall {r} {c}.
Crypto c =>
BHeader c
-> (BHBody c -> SignedKES (KES c) (BHBody c) -> r)
-> ((# #) -> r)
-> r
$bBHeader :: forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
BHeader bHeaderBody' bHeaderSig' <-
  (getMemoRawType -> BHeaderRaw bHeaderBody' bHeaderSig')
  where
    BHeader BHBody c
bHeaderBody SignedKES (KES c) (BHBody c)
bHeaderSig =
      Version -> RawType (BHeader c) -> BHeader c
forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized (ProtVer -> Version
pvMajor (BHBody c -> ProtVer
forall c. BHBody c -> ProtVer
bprotver BHBody c
bHeaderBody)) (RawType (BHeader c) -> BHeader c)
-> RawType (BHeader c) -> BHeader c
forall a b. (a -> b) -> a -> b
$ BHBody c -> SignedKES (KES c) (BHBody c) -> BHeaderRaw c
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 Blake2b_256 EraIndependentBlockHeader -> HashHeader
HashHeader (Hash Blake2b_256 EraIndependentBlockHeader -> HashHeader)
-> (BHeader c -> Hash Blake2b_256 EraIndependentBlockHeader)
-> BHeader c
-> HashHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentBlockHeader
-> Hash Blake2b_256 EraIndependentBlockHeader
forall i. SafeHash i -> Hash Blake2b_256 i
extractHash (SafeHash EraIndependentBlockHeader
 -> Hash Blake2b_256 EraIndependentBlockHeader)
-> (BHeader c -> SafeHash EraIndependentBlockHeader)
-> BHeader c
-> Hash Blake2b_256 EraIndependentBlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader c -> SafeHash EraIndependentBlockHeader
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated

-- | HashHeader to Nonce
hashHeaderToNonce :: HashHeader -> Nonce
hashHeaderToNonce :: HashHeader -> Nonce
hashHeaderToNonce (HashHeader Hash Blake2b_256 EraIndependentBlockHeader
h) = 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 EraIndependentBlockHeader
-> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
Hash.castHash Hash Blake2b_256 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 = VKey 'BlockIssuer -> KeyHash 'BlockIssuer
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'BlockIssuer -> KeyHash 'BlockIssuer)
-> (BHBody c -> VKey 'BlockIssuer)
-> BHBody c
-> KeyHash 'BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody c -> VKey 'BlockIssuer
forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk

{-# DEPRECATED bHeaderSize "In favor of `originalBytesSize`" #-}
bHeaderSize :: BHeader c -> Int
bHeaderSize :: forall c. BHeader c -> Int
bHeaderSize = BHeader c -> Int
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 = BHBody c -> Word32
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 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxVal
    then Natural -> Natural -> BoundedNatural
UnsafeBoundedNatural Natural
maxVal Natural
val
    else [Char] -> BoundedNatural
forall a. HasCallStack => [Char] -> a
error ([Char] -> BoundedNatural) -> [Char] -> BoundedNatural
forall a b. (a -> b) -> a -> b
$ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
val [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is greater than max value " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> [Char]
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 (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
forall (proxy :: * -> *). 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 =
      case Integer -> Maybe (NonZero Integer)
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero (Integer -> Maybe (NonZero Integer))
-> (Natural -> Integer) -> Natural -> Maybe (NonZero Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Maybe (NonZero Integer))
-> Natural -> Maybe (NonZero Integer)
forall a b. (a -> b) -> a -> b
$ Natural
certNatMax Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
certNat of
        Just NonZero Integer
d -> Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
certNatMax Integer -> NonZero Integer -> Rational
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 = -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 = LastAppliedBlock
  { LastAppliedBlock -> BlockNo
labBlockNo :: !BlockNo
  , LastAppliedBlock -> SlotNo
labSlotNo :: !SlotNo
  , LastAppliedBlock -> HashHeader
labHash :: !HashHeader
  }
  deriving (Int -> LastAppliedBlock -> ShowS
[LastAppliedBlock] -> ShowS
LastAppliedBlock -> [Char]
(Int -> LastAppliedBlock -> ShowS)
-> (LastAppliedBlock -> [Char])
-> ([LastAppliedBlock] -> ShowS)
-> Show LastAppliedBlock
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LastAppliedBlock -> ShowS
showsPrec :: Int -> LastAppliedBlock -> ShowS
$cshow :: LastAppliedBlock -> [Char]
show :: LastAppliedBlock -> [Char]
$cshowList :: [LastAppliedBlock] -> ShowS
showList :: [LastAppliedBlock] -> ShowS
Show, LastAppliedBlock -> LastAppliedBlock -> Bool
(LastAppliedBlock -> LastAppliedBlock -> Bool)
-> (LastAppliedBlock -> LastAppliedBlock -> Bool)
-> Eq LastAppliedBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LastAppliedBlock -> LastAppliedBlock -> Bool
== :: LastAppliedBlock -> LastAppliedBlock -> Bool
$c/= :: LastAppliedBlock -> LastAppliedBlock -> Bool
/= :: LastAppliedBlock -> LastAppliedBlock -> Bool
Eq, (forall x. LastAppliedBlock -> Rep LastAppliedBlock x)
-> (forall x. Rep LastAppliedBlock x -> LastAppliedBlock)
-> Generic LastAppliedBlock
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
$cfrom :: forall x. LastAppliedBlock -> Rep LastAppliedBlock x
from :: forall x. LastAppliedBlock -> Rep LastAppliedBlock x
$cto :: forall x. Rep LastAppliedBlock x -> LastAppliedBlock
to :: forall x. Rep LastAppliedBlock x -> LastAppliedBlock
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BlockNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR BlockNo
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SlotNo
s Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> HashHeader -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR HashHeader
h

instance DecCBOR LastAppliedBlock where
  decCBOR :: forall s. Decoder s LastAppliedBlock
decCBOR =
    Text
-> (LastAppliedBlock -> Int)
-> Decoder s LastAppliedBlock
-> Decoder s LastAppliedBlock
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"lastAppliedBlock"
      (Int -> LastAppliedBlock -> Int
forall a b. a -> b -> a
const Int
3)
      ( BlockNo -> SlotNo -> HashHeader -> LastAppliedBlock
LastAppliedBlock
          (BlockNo -> SlotNo -> HashHeader -> LastAppliedBlock)
-> Decoder s BlockNo
-> Decoder s (SlotNo -> HashHeader -> LastAppliedBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s BlockNo
forall s. Decoder s BlockNo
forall a s. DecCBOR a => Decoder s a
decCBOR
          Decoder s (SlotNo -> HashHeader -> LastAppliedBlock)
-> Decoder s SlotNo -> Decoder s (HashHeader -> LastAppliedBlock)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
          Decoder s (HashHeader -> LastAppliedBlock)
-> Decoder s HashHeader -> Decoder s LastAppliedBlock
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s HashHeader
forall s. Decoder s HashHeader
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 (HashHeader -> PrevHash) -> HashHeader -> PrevHash
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 = OutputVRF (VRF c) -> Nonce
forall v. OutputVRF v -> Nonce
mkNonceFromOutputVRF (OutputVRF (VRF c) -> Nonce)
-> (BHBody c -> OutputVRF (VRF c)) -> BHBody c -> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertifiedVRF (VRF c) Nonce -> OutputVRF (VRF c)
forall v a. CertifiedVRF v a -> OutputVRF v
VRF.certifiedOutput (CertifiedVRF (VRF c) Nonce -> OutputVRF (VRF c))
-> (BHBody c -> CertifiedVRF (VRF c) Nonce)
-> BHBody c
-> OutputVRF (VRF c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody c -> CertifiedVRF (VRF c) Nonce
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 Blake2b_256 EraIndependentBlockBody
-> SlotNo
-> BHeaderView
BHeaderView
    (VKey 'BlockIssuer -> KeyHash 'BlockIssuer
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'BlockIssuer -> KeyHash 'BlockIssuer)
-> (BHBody c -> VKey 'BlockIssuer)
-> BHBody c
-> KeyHash 'BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody c -> VKey 'BlockIssuer
forall c. BHBody c -> VKey 'BlockIssuer
bheaderVk (BHBody c -> KeyHash 'BlockIssuer)
-> BHBody c -> KeyHash 'BlockIssuer
forall a b. (a -> b) -> a -> b
$ BHBody c
bhb)
    (BHBody c -> Word32
forall c. BHBody c -> Word32
bsize BHBody c
bhb)
    (BHeader c -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize BHeader c
bh)
    (BHBody c -> Hash Blake2b_256 EraIndependentBlockBody
forall c. BHBody c -> Hash Blake2b_256 EraIndependentBlockBody
bhash BHBody c
bhb)
    (BHBody c -> SlotNo
forall c. BHBody c -> SlotNo
bheaderSlotNo BHBody c
bhb)