{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Shelley.Spec.Ledger.BlockChain
  ( HashHeader (..),
    PrevHash (..),
    LastAppliedBlock (..),
    lastAppliedHash,
    BHBody (..),
    poolIDfromBHBody,
    issuerIDfromBHBody,
    BHeader (BHeader),
    Block (Block, Block'),
    LaxBlock (..),
    TxSeq (TxSeq, txSeqTxns', TxSeq'),
    HashBBody (..),
    bhHash,
    bbHash,
    hashHeaderToNonce,
    prevHashToNonce,
    bHeaderSize,
    bBodySize,
    slotToNonce,
    hBbsize,
    -- accessor functions
    bheader,
    bhbody,
    bbody,
    bnonce,
    --
    seedEta,
    seedL,
    incrBlocks,
    mkSeed,
    checkLeaderValue,
  )
where

import Cardano.Binary
  ( Annotator (..),
    Case (..),
    Decoder,
    FromCBOR (fromCBOR),
    ToCBOR (..),
    TokenType (TypeNull),
    annotatorSlice,
    decodeNull,
    encodeListLen,
    encodeNull,
    encodePreEncoded,
    peekTokenType,
    serialize',
    serializeEncoding,
    serializeEncoding',
    szCases,
    withSlice,
    withWordSize,
  )
import qualified Cardano.Crypto.Hash.Class as Hash
import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util (SignableRepresentation (..))
import qualified Cardano.Crypto.VRF as VRF
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley (ShelleyBased)
import qualified Cardano.Ledger.Shelley as Shelley
import Cardano.Slotting.Slot (WithOrigin (..))
import Control.DeepSeq (NFData)
import Control.Monad (unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Builder.Extra as BS
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Ratio ((%))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Numeric.Natural (Natural)
import Shelley.Spec.Ledger.BaseTypes
  ( ActiveSlotCoeff,
    FixedPoint,
    Nonce (..),
    Seed (..),
    activeSlotLog,
    activeSlotVal,
    intervalValue,
    mkNonceFromNumber,
    mkNonceFromOutputVRF,
    strictMaybeToMaybe,
  )
import Shelley.Spec.Ledger.EpochBoundary (BlocksMade (..))
import Shelley.Spec.Ledger.Hashing (EraIndependentBlockBody)
import Shelley.Spec.Ledger.Keys
  ( CertifiedVRF,
    Hash,
    KeyHash,
    KeyRole (..),
    SignedKES,
    VKey,
    VerKeyVRF,
    decodeSignedKES,
    decodeVerKeyVRF,
    encodeSignedKES,
    encodeVerKeyVRF,
    hashKey,
  )
import Shelley.Spec.Ledger.OCert (OCert (..))
import Shelley.Spec.Ledger.PParams (ProtVer (..))
import Shelley.Spec.Ledger.Serialization
  ( FromCBORGroup (..),
    ToCBORGroup (..),
    decodeMap,
    decodeRecordNamed,
    decodeSeq,
    encodeFoldableEncoder,
    encodeFoldableMapEncoder,
    listLenInt,
    runByteBuilder,
  )
import Shelley.Spec.Ledger.Slot (BlockNo (..), SlotNo (..))
import Shelley.Spec.Ledger.Tx (Tx (..), ValidateScript, decodeWits, segwitTx, txWitsBytes)
import Shelley.Spec.NonIntegral (CompareResult (..), taylorExpCmp)

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

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

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

data TxSeq era = TxSeq'
  { TxSeq era -> StrictSeq (Tx era)
txSeqTxns' :: !(StrictSeq (Tx era)),
    TxSeq era -> ByteString
txSeqBodyBytes :: BSL.ByteString,
    TxSeq era -> ByteString
txSeqWitsBytes :: BSL.ByteString,
    TxSeq era -> ByteString
txSeqMetadataBytes :: BSL.ByteString
  }
  deriving ((forall x. TxSeq era -> Rep (TxSeq era) x)
-> (forall x. Rep (TxSeq era) x -> TxSeq era)
-> Generic (TxSeq era)
forall x. Rep (TxSeq era) x -> TxSeq era
forall x. TxSeq era -> Rep (TxSeq era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxSeq era) x -> TxSeq era
forall era x. TxSeq era -> Rep (TxSeq era) x
$cto :: forall era x. Rep (TxSeq era) x -> TxSeq era
$cfrom :: forall era x. TxSeq era -> Rep (TxSeq era) x
Generic)

deriving via
  AllowThunksIn
    '[ "txSeqBodyBytes",
       "txSeqWitsBytes",
       "txSeqMetadataBytes"
     ]
    (TxSeq era)
  instance
    ShelleyBased era => NoThunks (TxSeq era)

deriving stock instance
  ShelleyBased era =>
  Show (TxSeq era)

deriving stock instance
  ShelleyBased era =>
  Eq (TxSeq era)

pattern TxSeq ::
  (Era era, Shelley.TxBodyConstraints era) =>
  StrictSeq (Tx era) ->
  TxSeq era
pattern $bTxSeq :: StrictSeq (Tx era) -> TxSeq era
$mTxSeq :: forall r era.
(Era era, TxBodyConstraints era) =>
TxSeq era -> (StrictSeq (Tx era) -> r) -> (Void# -> r) -> r
TxSeq xs <-
  TxSeq' xs _ _ _
  where
    TxSeq StrictSeq (Tx era)
txns =
      let serializeFoldable :: f ByteString -> ByteString
serializeFoldable f ByteString
x =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              (ByteString -> Encoding) -> f ByteString -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder (ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding)
-> (ByteString -> ByteString) -> ByteString -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) f ByteString
x
          metaChunk :: a -> StrictMaybe a -> Maybe Encoding
metaChunk a
index StrictMaybe a
m =
            ( \a
metadata ->
                a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
index Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
metadata
            )
              (a -> Encoding) -> Maybe a -> Maybe Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe a -> Maybe a
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe a
m
       in TxSeq' :: forall era.
StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
TxSeq'
            { txSeqTxns' :: StrictSeq (Tx era)
txSeqTxns' = StrictSeq (Tx era)
txns,
              txSeqBodyBytes :: ByteString
txSeqBodyBytes =
                Encoding -> ByteString
serializeEncoding (Encoding -> ByteString)
-> (StrictSeq (Tx era) -> Encoding)
-> StrictSeq (Tx era)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx era -> Encoding) -> StrictSeq (Tx era) -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder (TxBody era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (TxBody era -> Encoding)
-> (Tx era -> TxBody era) -> Tx era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> TxBody era
forall era. Tx era -> TxBodyConstraints era => TxBody era
_body) (StrictSeq (Tx era) -> ByteString)
-> StrictSeq (Tx era) -> ByteString
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era)
txns,
              txSeqWitsBytes :: ByteString
txSeqWitsBytes = StrictSeq ByteString -> ByteString
forall (f :: * -> *). Foldable f => f ByteString -> ByteString
serializeFoldable (StrictSeq ByteString -> ByteString)
-> StrictSeq ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ WitnessSetHKD Identity era -> ByteString
forall (f :: * -> *) era. WitnessSetHKD f era -> ByteString
txWitsBytes (WitnessSetHKD Identity era -> ByteString)
-> (Tx era -> WitnessSetHKD Identity era) -> Tx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> WitnessSetHKD Identity era
forall era. Tx era -> TxBodyConstraints era => WitnessSet era
_witnessSet (Tx era -> ByteString)
-> StrictSeq (Tx era) -> StrictSeq ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
txns,
              txSeqMetadataBytes :: ByteString
txSeqMetadataBytes =
                Encoding -> ByteString
serializeEncoding (Encoding -> ByteString)
-> (StrictSeq (StrictMaybe MetaData) -> Encoding)
-> StrictSeq (StrictMaybe MetaData)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> StrictMaybe MetaData -> Maybe Encoding)
-> StrictSeq (StrictMaybe MetaData) -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(Word -> a -> Maybe Encoding) -> f a -> Encoding
encodeFoldableMapEncoder Word -> StrictMaybe MetaData -> Maybe Encoding
forall a a.
(ToCBOR a, ToCBOR a) =>
a -> StrictMaybe a -> Maybe Encoding
metaChunk (StrictSeq (StrictMaybe MetaData) -> ByteString)
-> StrictSeq (StrictMaybe MetaData) -> ByteString
forall a b. (a -> b) -> a -> b
$
                  Tx era -> StrictMaybe MetaData
forall era. Tx era -> TxBodyConstraints era => StrictMaybe MetaData
_metadata (Tx era -> StrictMaybe MetaData)
-> StrictSeq (Tx era) -> StrictSeq (StrictMaybe MetaData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Tx era)
txns
            }

{-# COMPLETE TxSeq #-}

instance
  Era era =>
  ToCBORGroup (TxSeq era)
  where
  toCBORGroup :: TxSeq era -> Encoding
toCBORGroup (TxSeq' StrictSeq (Tx era)
_ ByteString
bodyBytes ByteString
witsBytes ByteString
metadataBytes) =
    ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$
      ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString
bodyBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
witsBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
metadataBytes
  encodedGroupSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxSeq era) -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (TxSeq era)
_proxy =
    (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy ByteString
forall k (t :: k). Proxy t
Proxy :: Proxy ByteString)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy ByteString
forall k (t :: k). Proxy t
Proxy :: Proxy ByteString)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy ByteString
forall k (t :: k). Proxy t
Proxy :: Proxy ByteString)
  listLen :: TxSeq era -> Word
listLen TxSeq era
_ = Word
3
  listLenBound :: Proxy (TxSeq era) -> Word
listLenBound Proxy (TxSeq era)
_ = Word
3

-- | Hash of block body
newtype HashBBody crypto = UnsafeHashBBody {HashBBody crypto -> Hash crypto EraIndependentBlockBody
unHashBody :: (Hash crypto EraIndependentBlockBody)}
  deriving stock (Int -> HashBBody crypto -> ShowS
[HashBBody crypto] -> ShowS
HashBBody crypto -> String
(Int -> HashBBody crypto -> ShowS)
-> (HashBBody crypto -> String)
-> ([HashBBody crypto] -> ShowS)
-> Show (HashBBody crypto)
forall crypto. Int -> HashBBody crypto -> ShowS
forall crypto. [HashBBody crypto] -> ShowS
forall crypto. HashBBody crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashBBody crypto] -> ShowS
$cshowList :: forall crypto. [HashBBody crypto] -> ShowS
show :: HashBBody crypto -> String
$cshow :: forall crypto. HashBBody crypto -> String
showsPrec :: Int -> HashBBody crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> HashBBody crypto -> ShowS
Show, HashBBody crypto -> HashBBody crypto -> Bool
(HashBBody crypto -> HashBBody crypto -> Bool)
-> (HashBBody crypto -> HashBBody crypto -> Bool)
-> Eq (HashBBody crypto)
forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashBBody crypto -> HashBBody crypto -> Bool
$c/= :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
== :: HashBBody crypto -> HashBBody crypto -> Bool
$c== :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
Eq, Eq (HashBBody crypto)
Eq (HashBBody crypto)
-> (HashBBody crypto -> HashBBody crypto -> Ordering)
-> (HashBBody crypto -> HashBBody crypto -> Bool)
-> (HashBBody crypto -> HashBBody crypto -> Bool)
-> (HashBBody crypto -> HashBBody crypto -> Bool)
-> (HashBBody crypto -> HashBBody crypto -> Bool)
-> (HashBBody crypto -> HashBBody crypto -> HashBBody crypto)
-> (HashBBody crypto -> HashBBody crypto -> HashBBody crypto)
-> Ord (HashBBody crypto)
HashBBody crypto -> HashBBody crypto -> Bool
HashBBody crypto -> HashBBody crypto -> Ordering
HashBBody crypto -> HashBBody crypto -> HashBBody crypto
forall crypto. Eq (HashBBody crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
forall crypto. HashBBody crypto -> HashBBody crypto -> Ordering
forall crypto.
HashBBody crypto -> HashBBody crypto -> HashBBody crypto
min :: HashBBody crypto -> HashBBody crypto -> HashBBody crypto
$cmin :: forall crypto.
HashBBody crypto -> HashBBody crypto -> HashBBody crypto
max :: HashBBody crypto -> HashBBody crypto -> HashBBody crypto
$cmax :: forall crypto.
HashBBody crypto -> HashBBody crypto -> HashBBody crypto
>= :: HashBBody crypto -> HashBBody crypto -> Bool
$c>= :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
> :: HashBBody crypto -> HashBBody crypto -> Bool
$c> :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
<= :: HashBBody crypto -> HashBBody crypto -> Bool
$c<= :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
< :: HashBBody crypto -> HashBBody crypto -> Bool
$c< :: forall crypto. HashBBody crypto -> HashBBody crypto -> Bool
compare :: HashBBody crypto -> HashBBody crypto -> Ordering
$ccompare :: forall crypto. HashBBody crypto -> HashBBody crypto -> Ordering
$cp1Ord :: forall crypto. Eq (HashBBody crypto)
Ord)
  deriving newtype (Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
Proxy (HashBBody crypto) -> String
(Context -> HashBBody crypto -> IO (Maybe ThunkInfo))
-> (Context -> HashBBody crypto -> IO (Maybe ThunkInfo))
-> (Proxy (HashBBody crypto) -> String)
-> NoThunks (HashBBody crypto)
forall crypto. Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (HashBBody crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (HashBBody crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (HashBBody crypto) -> String
wNoThunks :: Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> HashBBody crypto -> IO (Maybe ThunkInfo)
NoThunks)

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

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

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

-- | Hash a given block body
bbHash ::
  forall era.
  Era era =>
  TxSeq era ->
  HashBBody (Crypto era)
bbHash :: TxSeq era -> HashBBody (Crypto era)
bbHash (TxSeq' StrictSeq (Tx era)
_ ByteString
bodies ByteString
wits ByteString
md) =
  (Hash (HASH (Crypto era)) EraIndependentBlockBody
-> HashBBody (Crypto era)
forall crypto.
Hash crypto EraIndependentBlockBody -> HashBBody crypto
UnsafeHashBBody (Hash (HASH (Crypto era)) EraIndependentBlockBody
 -> HashBBody (Crypto era))
-> (Hash (HASH (Crypto era)) ByteString
    -> Hash (HASH (Crypto era)) EraIndependentBlockBody)
-> Hash (HASH (Crypto era)) ByteString
-> HashBBody (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH (Crypto era)) ByteString
-> Hash (HASH (Crypto era)) EraIndependentBlockBody
coerce) (Hash (HASH (Crypto era)) ByteString -> HashBBody (Crypto era))
-> Hash (HASH (Crypto era)) ByteString -> HashBBody (Crypto era)
forall a b. (a -> b) -> a -> b
$
    ByteString -> Hash (HASH (Crypto era)) ByteString
hashStrict (ByteString -> ByteString
hashPart ByteString
bodies ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hashPart ByteString
wits ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hashPart ByteString
md)
  where
    hashStrict :: ByteString -> Hash (Crypto era) ByteString
    hashStrict :: ByteString -> Hash (HASH (Crypto era)) ByteString
hashStrict = (ByteString -> ByteString)
-> ByteString -> Hash (HASH (Crypto era)) ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
    hashPart :: ByteString -> ByteString
hashPart = Hash (HASH (Crypto era)) ByteString -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes (Hash (HASH (Crypto era)) ByteString -> ByteString)
-> (ByteString -> Hash (HASH (Crypto era)) ByteString)
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash (HASH (Crypto era)) ByteString
hashStrict (ByteString -> Hash (HASH (Crypto era)) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Hash (HASH (Crypto era)) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict

-- | HashHeader to Nonce
hashHeaderToNonce :: HashHeader crypto -> Nonce
hashHeaderToNonce :: HashHeader crypto -> Nonce
hashHeaderToNonce = Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> (HashHeader crypto -> Hash Blake2b_256 Nonce)
-> HashHeader crypto
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashHeader crypto -> Hash Blake2b_256 Nonce
coerce

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

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

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

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

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

{-# COMPLETE BHeader #-}

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

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

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

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

instance
  CC.Crypto crypto =>
  ToCBOR (PrevHash crypto)
  where
  toCBOR :: PrevHash crypto -> Encoding
toCBOR PrevHash crypto
GenesisHash = Encoding
encodeNull
  toCBOR (BlockHash HashHeader crypto
h) = HashHeader crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HashHeader crypto
h
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PrevHash crypto) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (PrevHash crypto)
proxy =
    [Case Size] -> Size
szCases
      [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"GenesisHash" Size
1,
        Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case
          Text
"BlockHash"
          ( (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (HashHeader crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr
              forall t. ToCBOR t => Proxy t -> Size
size
              ( ( \case
                    -- we are mapping a 'Proxy', so nothing can
                    -- go wrong here
                    PrevHash crypto
GenesisHash -> String -> HashHeader crypto
forall a. HasCallStack => String -> a
error String
"impossible happend"
                    BlockHash HashHeader crypto
h -> HashHeader crypto
h
                )
                  (PrevHash crypto -> HashHeader crypto)
-> Proxy (PrevHash crypto) -> Proxy (HashHeader crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PrevHash crypto)
proxy
              )
          )
      ]

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

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

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

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

instance NFData (LastAppliedBlock crypto)

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

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

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

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

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

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

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

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

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

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

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

-- | Retrieve the pool id (the hash of the pool operator's cold key)
-- from the body of the block header.
poolIDfromBHBody :: CC.Crypto crypto => BHBody crypto -> KeyHash 'BlockIssuer crypto
poolIDfromBHBody :: BHBody crypto -> KeyHash 'BlockIssuer crypto
poolIDfromBHBody = VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey (VKey 'BlockIssuer crypto -> KeyHash 'BlockIssuer crypto)
-> (BHBody crypto -> VKey 'BlockIssuer crypto)
-> BHBody crypto
-> KeyHash 'BlockIssuer crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHBody crypto -> VKey 'BlockIssuer crypto
forall crypto. BHBody crypto -> VKey 'BlockIssuer crypto
bheaderVk
{-# DEPRECATED poolIDfromBHBody "poolIDfromBHBody has been deprecated (the name is misleading), use issuerIDfromBHBody" #-}

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

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

data Block era
  = Block' !(BHeader (Crypto era)) !(TxSeq era) BSL.ByteString
  deriving ((forall x. Block era -> Rep (Block era) x)
-> (forall x. Rep (Block era) x -> Block era)
-> Generic (Block era)
forall x. Rep (Block era) x -> Block era
forall x. Block era -> Rep (Block era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Block era) x -> Block era
forall era x. Block era -> Rep (Block era) x
$cto :: forall era x. Rep (Block era) x -> Block era
$cfrom :: forall era x. Block era -> Rep (Block era) x
Generic)

deriving stock instance
  ShelleyBased era =>
  Show (Block era)

deriving stock instance
  ShelleyBased era =>
  Eq (Block era)

deriving anyclass instance
  ShelleyBased era =>
  NoThunks (Block era)

pattern Block :: Era era => BHeader (Crypto era) -> TxSeq era -> Block era
pattern $bBlock :: BHeader (Crypto era) -> TxSeq era -> Block era
$mBlock :: forall r era.
Era era =>
Block era
-> (BHeader (Crypto era) -> TxSeq era -> r) -> (Void# -> r) -> r
Block h txns <-
  Block' h txns _
  where
    Block BHeader (Crypto era)
h TxSeq era
txns =
      let bytes :: ByteString
bytes =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TxSeq era -> Word
forall a. ToCBORGroup a => a -> Word
listLen TxSeq era
txns) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BHeader (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR BHeader (Crypto era)
h Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxSeq era -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup TxSeq era
txns
       in BHeader (Crypto era) -> TxSeq era -> ByteString -> Block era
forall era.
BHeader (Crypto era) -> TxSeq era -> ByteString -> Block era
Block' BHeader (Crypto era)
h TxSeq era
txns ByteString
bytes

{-# COMPLETE Block #-}

-- | Given a size and a mapping from indices to maybe metadata,
--  return a sequence whose size is the size paramater and
--  whose non-Nothing values correspond no the values in the mapping.
constructMetaData :: Int -> Map Int a -> Seq (Maybe a)
constructMetaData :: Int -> Map Int a -> Seq (Maybe a)
constructMetaData Int
n Map Int a
md = (Int -> Maybe a) -> Seq Int -> Seq (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Map Int a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map Int a
md) ([Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])

instance
  Era era =>
  ToCBOR (Block era)
  where
  toCBOR :: Block era -> Encoding
toCBOR (Block' BHeader (Crypto era)
_ TxSeq era
_ ByteString
blockBytes) = ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
blockBytes

blockDecoder ::
  (ShelleyBased era, ValidateScript era) =>
  Bool ->
  forall s. Decoder s (Annotator (Block era))
blockDecoder :: Bool -> forall s. Decoder s (Annotator (Block era))
blockDecoder Bool
lax = Decoder s (Annotator (ByteString -> Block era))
-> Decoder s (Annotator (Block era))
forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice (Decoder s (Annotator (ByteString -> Block era))
 -> Decoder s (Annotator (Block era)))
-> Decoder s (Annotator (ByteString -> Block era))
-> Decoder s (Annotator (Block era))
forall a b. (a -> b) -> a -> b
$
  Text
-> (Annotator (ByteString -> Block era) -> Int)
-> Decoder s (Annotator (ByteString -> Block era))
-> Decoder s (Annotator (ByteString -> Block era))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (Int -> Annotator (ByteString -> Block era) -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (Annotator (ByteString -> Block era))
 -> Decoder s (Annotator (ByteString -> Block era)))
-> Decoder s (Annotator (ByteString -> Block era))
-> Decoder s (Annotator (ByteString -> Block era))
forall a b. (a -> b) -> a -> b
$ do
    Annotator (BHeader (Crypto era))
header <- Decoder s (Annotator (BHeader (Crypto era)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Annotator (TxSeq era)
txns <- Bool -> forall s. Decoder s (Annotator (TxSeq era))
forall era.
(ShelleyBased era, ValidateScript era) =>
Bool -> forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder Bool
lax
    Annotator (ByteString -> Block era)
-> Decoder s (Annotator (ByteString -> Block era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (ByteString -> Block era)
 -> Decoder s (Annotator (ByteString -> Block era)))
-> Annotator (ByteString -> Block era)
-> Decoder s (Annotator (ByteString -> Block era))
forall a b. (a -> b) -> a -> b
$ BHeader (Crypto era) -> TxSeq era -> ByteString -> Block era
forall era.
BHeader (Crypto era) -> TxSeq era -> ByteString -> Block era
Block' (BHeader (Crypto era) -> TxSeq era -> ByteString -> Block era)
-> Annotator (BHeader (Crypto era))
-> Annotator (TxSeq era -> ByteString -> Block era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (BHeader (Crypto era))
header Annotator (TxSeq era -> ByteString -> Block era)
-> Annotator (TxSeq era) -> Annotator (ByteString -> Block era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator (TxSeq era)
txns

txSeqDecoder ::
  (ShelleyBased era, ValidateScript era) =>
  Bool ->
  forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder :: Bool -> forall s. Decoder s (Annotator (TxSeq era))
txSeqDecoder Bool
lax = do
  (Seq (Annotator (TxBody era))
bodies, Annotator ByteString
bodiesAnn) <- Decoder s (Seq (Annotator (TxBody era)))
-> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Annotator (TxBody era)))
 -> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString))
-> Decoder s (Seq (Annotator (TxBody era)))
-> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s (Annotator (TxBody era))
-> Decoder s (Seq (Annotator (TxBody era)))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s (Annotator (TxBody era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
  (Seq (Annotator (WitnessSet era))
wits, Annotator ByteString
witsAnn) <- Decoder s (Seq (Annotator (WitnessSet era)))
-> Decoder
     s (Seq (Annotator (WitnessSet era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Annotator (WitnessSet era)))
 -> Decoder
      s (Seq (Annotator (WitnessSet era)), Annotator ByteString))
-> Decoder s (Seq (Annotator (WitnessSet era)))
-> Decoder
     s (Seq (Annotator (WitnessSet era)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ Decoder s (Annotator (WitnessSet era))
-> Decoder s (Seq (Annotator (WitnessSet era)))
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s (Annotator (WitnessSet era))
forall era s.
(TxBodyConstraints era, AnnotatedData (Script era),
 ValidateScript era) =>
Decoder s (Annotator (WitnessSet era))
decodeWits
  let b :: Int
b = Seq (Annotator (TxBody era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxBody era))
bodies
      w :: Int
w = Seq (Annotator (WitnessSet era)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (WitnessSet era))
wits

  (Seq (Maybe (Annotator MetaData))
metadata, Annotator ByteString
metadataAnn) <-
    Decoder s (Seq (Maybe (Annotator MetaData)))
-> Decoder
     s (Seq (Maybe (Annotator MetaData)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Maybe (Annotator MetaData)))
 -> Decoder
      s (Seq (Maybe (Annotator MetaData)), Annotator ByteString))
-> Decoder s (Seq (Maybe (Annotator MetaData)))
-> Decoder
     s (Seq (Maybe (Annotator MetaData)), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$
      Int
-> Map Int (Annotator MetaData) -> Seq (Maybe (Annotator MetaData))
forall a. Int -> Map Int a -> Seq (Maybe a)
constructMetaData Int
b
        (Map Int (Annotator MetaData) -> Seq (Maybe (Annotator MetaData)))
-> Decoder s (Map Int (Annotator MetaData))
-> Decoder s (Seq (Maybe (Annotator MetaData)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
-> Decoder s (Annotator MetaData)
-> Decoder s (Map Int (Annotator MetaData))
forall a s b.
Ord a =>
Decoder s a -> Decoder s b -> Decoder s (Map a b)
decodeMap Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Annotator MetaData)
forall a s. FromCBOR a => Decoder s a
fromCBOR
  let m :: Int
m = Seq (Maybe (Annotator MetaData)) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Maybe (Annotator MetaData))
metadata

  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (Bool
lax Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w)
    ( String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String
"different number of transaction bodies ("
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
b
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") and witness sets ("
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
w
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    )
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (Bool
lax Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m)
    ( String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String
"mismatch between transaction bodies ("
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
b
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") and metadata ("
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
w
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    )
  let txns :: Annotator (StrictSeq (Tx era))
txns = StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era)))
-> StrictSeq (Annotator (Tx era)) -> Annotator (StrictSeq (Tx era))
forall a b. (a -> b) -> a -> b
$ Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era))
forall a. Seq a -> StrictSeq a
StrictSeq.toStrict (Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era)))
-> Seq (Annotator (Tx era)) -> StrictSeq (Annotator (Tx era))
forall a b. (a -> b) -> a -> b
$ (Annotator (TxBody era)
 -> Annotator (WitnessSet era)
 -> Maybe (Annotator MetaData)
 -> Annotator (Tx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (WitnessSet era))
-> Seq (Maybe (Annotator MetaData))
-> Seq (Annotator (Tx era))
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
Seq.zipWith3 Annotator (TxBody era)
-> Annotator (WitnessSet era)
-> Maybe (Annotator MetaData)
-> Annotator (Tx era)
forall era.
TxBodyConstraints era =>
Annotator (TxBody era)
-> Annotator (WitnessSet era)
-> Maybe (Annotator MetaData)
-> Annotator (Tx era)
segwitTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (WitnessSet era))
wits Seq (Maybe (Annotator MetaData))
metadata
  Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era)))
-> Annotator (TxSeq era) -> Decoder s (Annotator (TxSeq era))
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
forall era.
StrictSeq (Tx era)
-> ByteString -> ByteString -> ByteString -> TxSeq era
TxSeq' (StrictSeq (Tx era)
 -> ByteString -> ByteString -> ByteString -> TxSeq era)
-> Annotator (StrictSeq (Tx era))
-> Annotator (ByteString -> ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (Tx era))
txns Annotator (ByteString -> ByteString -> ByteString -> TxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bodiesAnn Annotator (ByteString -> ByteString -> TxSeq era)
-> Annotator ByteString -> Annotator (ByteString -> TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
witsAnn Annotator (ByteString -> TxSeq era)
-> Annotator ByteString -> Annotator (TxSeq era)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
metadataAnn

instance
  (ShelleyBased era, ValidateScript era) =>
  FromCBOR (Annotator (Block era))
  where
  fromCBOR :: Decoder s (Annotator (Block era))
fromCBOR = Bool -> forall s. Decoder s (Annotator (Block era))
forall era.
(ShelleyBased era, ValidateScript era) =>
Bool -> forall s. Decoder s (Annotator (Block era))
blockDecoder Bool
False

newtype LaxBlock era
  = LaxBlock (Block era)
  deriving (Typeable (LaxBlock era)
Typeable (LaxBlock era)
-> (LaxBlock era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (LaxBlock era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [LaxBlock era] -> Size)
-> ToCBOR (LaxBlock era)
LaxBlock era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [LaxBlock era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (LaxBlock era) -> Size
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 era. Era era => Typeable (LaxBlock era)
forall era. Era era => LaxBlock era -> Encoding
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [LaxBlock era] -> Size
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (LaxBlock era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [LaxBlock era] -> Size
$cencodedListSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [LaxBlock era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (LaxBlock era) -> Size
$cencodedSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (LaxBlock era) -> Size
toCBOR :: LaxBlock era -> Encoding
$ctoCBOR :: forall era. Era era => LaxBlock era -> Encoding
$cp1ToCBOR :: forall era. Era era => Typeable (LaxBlock era)
ToCBOR) via (Block era)

deriving stock instance
  ShelleyBased era =>
  Show (LaxBlock era)

instance
  (ShelleyBased era, ValidateScript era) =>
  FromCBOR (Annotator (LaxBlock era))
  where
  fromCBOR :: Decoder s (Annotator (LaxBlock era))
fromCBOR = (Block era -> LaxBlock era)
-> Annotator (Block era) -> Annotator (LaxBlock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block era -> LaxBlock era
forall era. Block era -> LaxBlock era
LaxBlock (Annotator (Block era) -> Annotator (LaxBlock era))
-> Decoder s (Annotator (Block era))
-> Decoder s (Annotator (LaxBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> forall s. Decoder s (Annotator (Block era))
forall era.
(ShelleyBased era, ValidateScript era) =>
Bool -> forall s. Decoder s (Annotator (Block era))
blockDecoder Bool
True

bHeaderSize ::
  forall crypto.
  (CC.Crypto crypto) =>
  BHeader crypto ->
  Int
bHeaderSize :: BHeader crypto -> Int
bHeaderSize = ByteString -> Int
BS.length (ByteString -> Int)
-> (BHeader crypto -> ByteString) -> BHeader crypto -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BHeader crypto -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

bBodySize ::
  forall era.
  (Era era) =>
  TxSeq era ->
  Int
bBodySize :: TxSeq era -> Int
bBodySize = ByteString -> Int
BS.length (ByteString -> Int)
-> (TxSeq era -> ByteString) -> TxSeq era -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
serializeEncoding' (Encoding -> ByteString)
-> (TxSeq era -> Encoding) -> TxSeq era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq era -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup

slotToNonce :: SlotNo -> Nonce
slotToNonce :: SlotNo -> Nonce
slotToNonce (SlotNo Word64
s) = Word64 -> Nonce
mkNonceFromNumber Word64
s

bheader ::
  Era era =>
  Block era ->
  BHeader (Crypto era)
bheader :: Block era -> BHeader (Crypto era)
bheader (Block BHeader (Crypto era)
bh TxSeq era
_) = BHeader (Crypto era)
bh

bbody :: Era era => Block era -> TxSeq era
bbody :: Block era -> TxSeq era
bbody (Block BHeader (Crypto era)
_ TxSeq era
txs) = TxSeq era
txs

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

-- | 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)
         )

-- | Check that the certified input natural is valid for being slot leader. This
-- means we check that
--
-- fromNat (certNat) < 1 - (1 - f)^σ
--
-- where fromNat creates an appropriate value in [0;1] from the certified
-- natural. The calculation is done using the following optimization:
--
-- let p = fromNat (certNat) and c = ln(1 - f)
--
-- then           p < 1 - (1 - f)^σ
-- <=>  1 / (1 - p) < 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.
checkLeaderValue ::
  forall v.
  (VRF.VRFAlgorithm v) =>
  VRF.OutputVRF v ->
  Rational ->
  ActiveSlotCoeff ->
  Bool
checkLeaderValue :: OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderValue OutputVRF v
certVRF Rational
σ ActiveSlotCoeff
f =
  if (UnitInterval -> Ratio Word64
intervalValue (UnitInterval -> Ratio Word64) -> UnitInterval -> Ratio Word64
forall a b. (a -> b) -> a -> b
$ ActiveSlotCoeff -> UnitInterval
activeSlotVal ActiveSlotCoeff
f) Ratio Word64 -> Ratio Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Word64
1
    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
    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
* Proxy v -> Word
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
VRF.sizeOutputVRF (Proxy v
forall k (t :: k). Proxy t
Proxy @v))
    c, recip_q, x :: FixedPoint
    c :: FixedPoint
c = ActiveSlotCoeff -> FixedPoint
activeSlotLog ActiveSlotCoeff
f
    recip_q :: FixedPoint
recip_q = Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
certNatMax Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural
certNatMax Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
certNat))
    x :: FixedPoint
x = (- Rational -> FixedPoint
forall a. Fractional a => Rational -> a
fromRational Rational
σ FixedPoint -> FixedPoint -> FixedPoint
forall a. Num a => a -> a -> a
* FixedPoint
c)
    certNat :: Natural
    certNat :: Natural
certNat = OutputVRF v -> Natural
forall v. OutputVRF v -> Natural
VRF.getOutputVRFNatural OutputVRF v
certVRF

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

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

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

incrBlocks ::
  Bool ->
  KeyHash 'StakePool (Crypto era) ->
  BlocksMade era ->
  BlocksMade era
incrBlocks :: Bool
-> KeyHash 'StakePool (Crypto era)
-> BlocksMade era
-> BlocksMade era
incrBlocks Bool
isOverlay KeyHash 'StakePool (Crypto era)
hk b' :: BlocksMade era
b'@(BlocksMade Map (KeyHash 'StakePool (Crypto era)) Natural
b)
  | Bool
isOverlay = BlocksMade era
b'
  | Bool
otherwise = Map (KeyHash 'StakePool (Crypto era)) Natural -> BlocksMade era
forall era.
Map (KeyHash 'StakePool (Crypto era)) Natural -> BlocksMade era
BlocksMade (Map (KeyHash 'StakePool (Crypto era)) Natural -> BlocksMade era)
-> Map (KeyHash 'StakePool (Crypto era)) Natural -> BlocksMade era
forall a b. (a -> b) -> a -> b
$ case Maybe Natural
hkVal of
    Maybe Natural
Nothing -> KeyHash 'StakePool (Crypto era)
-> Natural
-> Map (KeyHash 'StakePool (Crypto era)) Natural
-> Map (KeyHash 'StakePool (Crypto era)) Natural
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool (Crypto era)
hk Natural
1 Map (KeyHash 'StakePool (Crypto era)) Natural
b
    Just Natural
n -> KeyHash 'StakePool (Crypto era)
-> Natural
-> Map (KeyHash 'StakePool (Crypto era)) Natural
-> Map (KeyHash 'StakePool (Crypto era)) Natural
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool (Crypto era)
hk (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) Map (KeyHash 'StakePool (Crypto era)) Natural
b
  where
    hkVal :: Maybe Natural
hkVal = KeyHash 'StakePool (Crypto era)
-> Map (KeyHash 'StakePool (Crypto era)) Natural -> Maybe Natural
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool (Crypto era)
hk Map (KeyHash 'StakePool (Crypto era)) Natural
b