{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Chain.Block.Block (
  -- * Block
  Block,
  ABlock (..),

  -- * Block Constructors
  mkBlock,
  mkBlockExplicit,

  -- * Block Accessors
  blockHash,
  blockHashAnnotated,
  blockAProtocolMagicId,
  blockProtocolMagicId,
  blockPrevHash,
  blockProof,
  blockSlot,
  blockGenesisKey,
  blockIssuer,
  blockDifficulty,
  blockToSign,
  blockSignature,
  blockProtocolVersion,
  blockSoftwareVersion,
  blockTxPayload,
  blockSscPayload,
  blockDlgPayload,
  blockUpdatePayload,
  blockLength,

  -- * Block Binary Serialization
  encCBORBlock,
  decCBORABlock,

  -- * Block Formatting
  renderBlock,

  -- * ABlockOrBoundary
  ABlockOrBoundary (..),
  encCBORABOBBlock,
  decCBORABOBBlock,
  decCBORABlockOrBoundary,
  encCBORABlockOrBoundary,

  -- * ABoundaryBlock
  ABoundaryBlock (..),
  boundaryHashAnnotated,
  decCBORABoundaryBlock,
  encCBORABoundaryBlock,
  encCBORABOBBoundary,
  boundaryBlockSlot,
  ABoundaryBody (..),

  -- * ABlockOrBoundaryHdr
  ABlockOrBoundaryHdr (..),
  aBlockOrBoundaryHdr,
  decCBORABlockOrBoundaryHdr,
  encCBORABlockOrBoundaryHdr,
  encCBORABlockOrBoundaryHdrSize,
  abobHdrFromBlock,
  abobHdrSlotNo,
  abobHdrChainDifficulty,
  abobHdrHash,
  abobHdrPrevHash,
) where

-- TODO `contramap` should be in `Cardano.Prelude`

import Cardano.Chain.Block.Body (
  ABody,
  Body,
  bodyDlgPayload,
  bodySscPayload,
  bodyTxPayload,
  bodyTxs,
  bodyUpdatePayload,
 )
import Cardano.Chain.Block.Boundary (
  dropBoundaryBody,
  dropBoundaryExtraBodyData,
 )
import Cardano.Chain.Block.Header (
  ABlockSignature,
  ABoundaryHeader (..),
  AHeader (..),
  Header,
  HeaderHash,
  ToSign,
  boundaryHeaderHashAnnotated,
  decCBORABoundaryHeader,
  decCBORAHeader,
  encCBORABoundaryHeader,
  encCBORABoundaryHeaderSize,
  encCBORHeader,
  encCBORHeaderSize,
  genesisHeaderHash,
  hashHeader,
  headerDifficulty,
  headerGenesisKey,
  headerHashAnnotated,
  headerIssuer,
  headerPrevHash,
  headerProof,
  headerProtocolMagicId,
  headerProtocolVersion,
  headerSignature,
  headerSlot,
  headerSoftwareVersion,
  headerToSign,
  mkHeaderExplicit,
 )
import Cardano.Chain.Block.Proof (Proof (..))
import Cardano.Chain.Common (ChainDifficulty (..), dropEmptyAttributes)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Genesis.Hash (GenesisHash (..))
import Cardano.Chain.Slotting (
  EpochSlots (..),
  SlotNumber (..),
  WithEpochSlots (WithEpochSlots),
 )
import Cardano.Chain.Ssc (SscPayload)
import Cardano.Chain.UTxO.TxPayload (ATxPayload)
import qualified Cardano.Chain.Update.Payload as Update
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.SoftwareVersion (SoftwareVersion)
import Cardano.Crypto (ProtocolMagicId, SigningKey, VerificationKey)
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan (..),
  Case (..),
  DecCBOR (..),
  Decoded (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  Encoding,
  Size,
  annotatedDecoder,
  cborError,
  encodeBreak,
  encodeListLen,
  encodeListLenIndef,
  encodePreEncoded,
  encodeWord,
  enforceSize,
  szCases,
 )
import Cardano.Prelude hiding (cborError)
import Control.Monad.Fail (fail)
import Control.Tracer (contramap)
import Data.Aeson (ToJSON)
import qualified Data.ByteString as BS
import Data.Text.Lazy.Builder (Builder, fromText)
import Formatting (bprint, build, int, later, shown)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Block
--------------------------------------------------------------------------------

type Block = ABlock ()

data ABlock a = ABlock
  { forall a. ABlock a -> AHeader a
blockHeader :: AHeader a
  , forall a. ABlock a -> ABody a
blockBody :: ABody a
  , forall a. ABlock a -> a
blockAnnotation :: a
  }
  deriving (ABlock a -> ABlock a -> Bool
(ABlock a -> ABlock a -> Bool)
-> (ABlock a -> ABlock a -> Bool) -> Eq (ABlock a)
forall a. Eq a => ABlock a -> ABlock a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ABlock a -> ABlock a -> Bool
== :: ABlock a -> ABlock a -> Bool
$c/= :: forall a. Eq a => ABlock a -> ABlock a -> Bool
/= :: ABlock a -> ABlock a -> Bool
Eq, Int -> ABlock a -> ShowS
[ABlock a] -> ShowS
ABlock a -> String
(Int -> ABlock a -> ShowS)
-> (ABlock a -> String) -> ([ABlock a] -> ShowS) -> Show (ABlock a)
forall a. Show a => Int -> ABlock a -> ShowS
forall a. Show a => [ABlock a] -> ShowS
forall a. Show a => ABlock a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABlock a -> ShowS
showsPrec :: Int -> ABlock a -> ShowS
$cshow :: forall a. Show a => ABlock a -> String
show :: ABlock a -> String
$cshowList :: forall a. Show a => [ABlock a] -> ShowS
showList :: [ABlock a] -> ShowS
Show, (forall x. ABlock a -> Rep (ABlock a) x)
-> (forall x. Rep (ABlock a) x -> ABlock a) -> Generic (ABlock a)
forall x. Rep (ABlock a) x -> ABlock a
forall x. ABlock a -> Rep (ABlock a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABlock a) x -> ABlock a
forall a x. ABlock a -> Rep (ABlock a) x
$cfrom :: forall a x. ABlock a -> Rep (ABlock a) x
from :: forall x. ABlock a -> Rep (ABlock a) x
$cto :: forall a x. Rep (ABlock a) x -> ABlock a
to :: forall x. Rep (ABlock a) x -> ABlock a
Generic, ABlock a -> ()
(ABlock a -> ()) -> NFData (ABlock a)
forall a. NFData a => ABlock a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => ABlock a -> ()
rnf :: ABlock a -> ()
NFData, (forall a b. (a -> b) -> ABlock a -> ABlock b)
-> (forall a b. a -> ABlock b -> ABlock a) -> Functor ABlock
forall a b. a -> ABlock b -> ABlock a
forall a b. (a -> b) -> ABlock a -> ABlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ABlock a -> ABlock b
fmap :: forall a b. (a -> b) -> ABlock a -> ABlock b
$c<$ :: forall a b. a -> ABlock b -> ABlock a
<$ :: forall a b. a -> ABlock b -> ABlock a
Functor)

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABlock a)

--------------------------------------------------------------------------------
-- Block Constructors
--------------------------------------------------------------------------------

-- | Smart constructor for 'Block'
mkBlock ::
  ProtocolMagicId ->
  ProtocolVersion ->
  SoftwareVersion ->
  Either GenesisHash Header ->
  EpochSlots ->
  SlotNumber ->
  -- | The 'SigningKey' used for signing the block
  SigningKey ->
  -- | A certificate of delegation from a genesis key to the 'SigningKey'
  Delegation.Certificate ->
  Body ->
  Block
mkBlock :: ProtocolMagicId
-> ProtocolVersion
-> SoftwareVersion
-> Either GenesisHash (AHeader ())
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> ABody ()
-> Block
mkBlock ProtocolMagicId
pm ProtocolVersion
bv SoftwareVersion
sv Either GenesisHash (AHeader ())
prevHeader EpochSlots
epochSlots =
  ProtocolMagicId
-> ProtocolVersion
-> SoftwareVersion
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> ABody ()
-> Block
mkBlockExplicit
    ProtocolMagicId
pm
    ProtocolVersion
bv
    SoftwareVersion
sv
    HeaderHash
prevHash
    ChainDifficulty
difficulty
    EpochSlots
epochSlots
  where
    prevHash :: HeaderHash
prevHash = (GenesisHash -> HeaderHash)
-> (AHeader () -> HeaderHash)
-> Either GenesisHash (AHeader ())
-> HeaderHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GenesisHash -> HeaderHash
genesisHeaderHash (EpochSlots -> AHeader () -> HeaderHash
hashHeader EpochSlots
epochSlots) Either GenesisHash (AHeader ())
prevHeader
    difficulty :: ChainDifficulty
difficulty =
      (GenesisHash -> ChainDifficulty)
-> (AHeader () -> ChainDifficulty)
-> Either GenesisHash (AHeader ())
-> ChainDifficulty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ChainDifficulty -> GenesisHash -> ChainDifficulty
forall a b. a -> b -> a
const (ChainDifficulty -> GenesisHash -> ChainDifficulty)
-> ChainDifficulty -> GenesisHash -> ChainDifficulty
forall a b. (a -> b) -> a -> b
$ Word64 -> ChainDifficulty
ChainDifficulty Word64
0) (ChainDifficulty -> ChainDifficulty
forall a. Enum a => a -> a
succ (ChainDifficulty -> ChainDifficulty)
-> (AHeader () -> ChainDifficulty) -> AHeader () -> ChainDifficulty
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AHeader () -> ChainDifficulty
forall a. AHeader a -> ChainDifficulty
headerDifficulty) Either GenesisHash (AHeader ())
prevHeader

-- | Smart constructor for 'Block', without requiring the entire previous
--   'Header'. Instead, you give its hash and the difficulty of this block.
--   These are derived from the previous header in 'mkBlock' so if you have
--   the previous header, consider using that one.
mkBlockExplicit ::
  ProtocolMagicId ->
  ProtocolVersion ->
  SoftwareVersion ->
  HeaderHash ->
  ChainDifficulty ->
  EpochSlots ->
  SlotNumber ->
  -- | The 'SigningKey' used for signing the block
  SigningKey ->
  -- | A certificate of delegation from a genesis key to the 'SigningKey'
  Delegation.Certificate ->
  Body ->
  Block
mkBlockExplicit :: ProtocolMagicId
-> ProtocolVersion
-> SoftwareVersion
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> ABody ()
-> Block
mkBlockExplicit ProtocolMagicId
pm ProtocolVersion
pv SoftwareVersion
sv HeaderHash
prevHash ChainDifficulty
difficulty EpochSlots
epochSlots SlotNumber
slotNumber SigningKey
sk Certificate
dlgCert ABody ()
body =
  AHeader () -> ABody () -> () -> Block
forall a. AHeader a -> ABody a -> a -> ABlock a
ABlock
    ( ProtocolMagicId
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> ABody ()
-> ProtocolVersion
-> SoftwareVersion
-> AHeader ()
mkHeaderExplicit
        ProtocolMagicId
pm
        HeaderHash
prevHash
        ChainDifficulty
difficulty
        EpochSlots
epochSlots
        SlotNumber
slotNumber
        SigningKey
sk
        Certificate
dlgCert
        ABody ()
body
        ProtocolVersion
pv
        SoftwareVersion
sv
    )
    ABody ()
body
    ()

--------------------------------------------------------------------------------
-- Block Accessors
--------------------------------------------------------------------------------

blockHash :: EpochSlots -> Block -> HeaderHash
blockHash :: EpochSlots -> Block -> HeaderHash
blockHash EpochSlots
epochSlots = EpochSlots -> AHeader () -> HeaderHash
hashHeader EpochSlots
epochSlots (AHeader () -> HeaderHash)
-> (Block -> AHeader ()) -> Block -> HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Block -> AHeader ()
forall a. ABlock a -> AHeader a
blockHeader

blockHashAnnotated :: ABlock ByteString -> HeaderHash
blockHashAnnotated :: ABlock ByteString -> HeaderHash
blockHashAnnotated = AHeader ByteString -> HeaderHash
headerHashAnnotated (AHeader ByteString -> HeaderHash)
-> (ABlock ByteString -> AHeader ByteString)
-> ABlock ByteString
-> HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock ByteString -> AHeader ByteString
forall a. ABlock a -> AHeader a
blockHeader

blockProtocolMagicId :: ABlock a -> ProtocolMagicId
blockProtocolMagicId :: forall a. ABlock a -> ProtocolMagicId
blockProtocolMagicId = AHeader a -> ProtocolMagicId
forall a. AHeader a -> ProtocolMagicId
headerProtocolMagicId (AHeader a -> ProtocolMagicId)
-> (ABlock a -> AHeader a) -> ABlock a -> ProtocolMagicId
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockAProtocolMagicId :: ABlock a -> Annotated ProtocolMagicId a
blockAProtocolMagicId :: forall a. ABlock a -> Annotated ProtocolMagicId a
blockAProtocolMagicId = AHeader a -> Annotated ProtocolMagicId a
forall a. AHeader a -> Annotated ProtocolMagicId a
aHeaderProtocolMagicId (AHeader a -> Annotated ProtocolMagicId a)
-> (ABlock a -> AHeader a)
-> ABlock a
-> Annotated ProtocolMagicId a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockPrevHash :: ABlock a -> HeaderHash
blockPrevHash :: forall a. ABlock a -> HeaderHash
blockPrevHash = AHeader a -> HeaderHash
forall a. AHeader a -> HeaderHash
headerPrevHash (AHeader a -> HeaderHash)
-> (ABlock a -> AHeader a) -> ABlock a -> HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockProof :: ABlock a -> Proof
blockProof :: forall a. ABlock a -> Proof
blockProof = AHeader a -> Proof
forall a. AHeader a -> Proof
headerProof (AHeader a -> Proof)
-> (ABlock a -> AHeader a) -> ABlock a -> Proof
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockSlot :: ABlock a -> SlotNumber
blockSlot :: forall a. ABlock a -> SlotNumber
blockSlot = AHeader a -> SlotNumber
forall a. AHeader a -> SlotNumber
headerSlot (AHeader a -> SlotNumber)
-> (ABlock a -> AHeader a) -> ABlock a -> SlotNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockGenesisKey :: ABlock a -> VerificationKey
blockGenesisKey :: forall a. ABlock a -> VerificationKey
blockGenesisKey = AHeader a -> VerificationKey
forall a. AHeader a -> VerificationKey
headerGenesisKey (AHeader a -> VerificationKey)
-> (ABlock a -> AHeader a) -> ABlock a -> VerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockIssuer :: ABlock a -> VerificationKey
blockIssuer :: forall a. ABlock a -> VerificationKey
blockIssuer = AHeader a -> VerificationKey
forall a. AHeader a -> VerificationKey
headerIssuer (AHeader a -> VerificationKey)
-> (ABlock a -> AHeader a) -> ABlock a -> VerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockDifficulty :: ABlock a -> ChainDifficulty
blockDifficulty :: forall a. ABlock a -> ChainDifficulty
blockDifficulty = AHeader a -> ChainDifficulty
forall a. AHeader a -> ChainDifficulty
headerDifficulty (AHeader a -> ChainDifficulty)
-> (ABlock a -> AHeader a) -> ABlock a -> ChainDifficulty
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockToSign :: EpochSlots -> ABlock a -> ToSign
blockToSign :: forall a. EpochSlots -> ABlock a -> ToSign
blockToSign EpochSlots
epochSlots = EpochSlots -> AHeader a -> ToSign
forall a. EpochSlots -> AHeader a -> ToSign
headerToSign EpochSlots
epochSlots (AHeader a -> ToSign)
-> (ABlock a -> AHeader a) -> ABlock a -> ToSign
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockSignature :: ABlock a -> ABlockSignature a
blockSignature :: forall a. ABlock a -> ABlockSignature a
blockSignature = AHeader a -> ABlockSignature a
forall a. AHeader a -> ABlockSignature a
headerSignature (AHeader a -> ABlockSignature a)
-> (ABlock a -> AHeader a) -> ABlock a -> ABlockSignature a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockProtocolVersion :: ABlock a -> ProtocolVersion
blockProtocolVersion :: forall a. ABlock a -> ProtocolVersion
blockProtocolVersion = AHeader a -> ProtocolVersion
forall a. AHeader a -> ProtocolVersion
headerProtocolVersion (AHeader a -> ProtocolVersion)
-> (ABlock a -> AHeader a) -> ABlock a -> ProtocolVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockSoftwareVersion :: ABlock a -> SoftwareVersion
blockSoftwareVersion :: forall a. ABlock a -> SoftwareVersion
blockSoftwareVersion = AHeader a -> SoftwareVersion
forall a. AHeader a -> SoftwareVersion
headerSoftwareVersion (AHeader a -> SoftwareVersion)
-> (ABlock a -> AHeader a) -> ABlock a -> SoftwareVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader

blockTxPayload :: ABlock a -> ATxPayload a
blockTxPayload :: forall a. ABlock a -> ATxPayload a
blockTxPayload = ABody a -> ATxPayload a
forall a. ABody a -> ATxPayload a
bodyTxPayload (ABody a -> ATxPayload a)
-> (ABlock a -> ABody a) -> ABlock a -> ATxPayload a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> ABody a
forall a. ABlock a -> ABody a
blockBody

blockSscPayload :: ABlock a -> SscPayload
blockSscPayload :: forall a. ABlock a -> SscPayload
blockSscPayload = ABody a -> SscPayload
forall a. ABody a -> SscPayload
bodySscPayload (ABody a -> SscPayload)
-> (ABlock a -> ABody a) -> ABlock a -> SscPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> ABody a
forall a. ABlock a -> ABody a
blockBody

blockUpdatePayload :: ABlock a -> Update.APayload a
blockUpdatePayload :: forall a. ABlock a -> APayload a
blockUpdatePayload = ABody a -> APayload a
forall a. ABody a -> APayload a
bodyUpdatePayload (ABody a -> APayload a)
-> (ABlock a -> ABody a) -> ABlock a -> APayload a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> ABody a
forall a. ABlock a -> ABody a
blockBody

blockDlgPayload :: ABlock a -> Delegation.APayload a
blockDlgPayload :: forall a. ABlock a -> APayload a
blockDlgPayload = ABody a -> APayload a
forall a. ABody a -> APayload a
bodyDlgPayload (ABody a -> APayload a)
-> (ABlock a -> ABody a) -> ABlock a -> APayload a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock a -> ABody a
forall a. ABlock a -> ABody a
blockBody

blockLength :: ABlock ByteString -> Natural
blockLength :: ABlock ByteString -> Natural
blockLength = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural)
-> (ABlock ByteString -> Int) -> ABlock ByteString -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Int
BS.length (ByteString -> Int)
-> (ABlock ByteString -> ByteString) -> ABlock ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock ByteString -> ByteString
forall a. ABlock a -> a
blockAnnotation

--------------------------------------------------------------------------------
-- Block Binary Serialization
--------------------------------------------------------------------------------

-- | Encode a block, given a number of slots-per-epoch.
--
--   Unlike 'encCBORABOBBlock', this function does not take the deprecated epoch
--   boundary blocks into account.
encCBORBlock :: EpochSlots -> Block -> Encoding
encCBORBlock :: EpochSlots -> Block -> Encoding
encCBORBlock EpochSlots
epochSlots Block
block =
  Word -> Encoding
encodeListLen Word
3
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochSlots -> AHeader () -> Encoding
encCBORHeader EpochSlots
epochSlots (Block -> AHeader ()
forall a. ABlock a -> AHeader a
blockHeader Block
block)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ABody () -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Block -> ABody ()
forall a. ABlock a -> ABody a
blockBody Block
block)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Word8 LByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Map Word8 LByteString
forall a. Monoid a => a
mempty :: Map Word8 LByteString))

decCBORABlock :: EpochSlots -> Decoder s (ABlock ByteSpan)
decCBORABlock :: forall s. EpochSlots -> Decoder s (ABlock ByteSpan)
decCBORABlock EpochSlots
epochSlots = do
  Annotated (AHeader ByteSpan
header, ABody ByteSpan
body) ByteSpan
byteSpan <- Decoder s (AHeader ByteSpan, ABody ByteSpan)
-> Decoder
     s (Annotated (AHeader ByteSpan, ABody ByteSpan) ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder (Decoder s (AHeader ByteSpan, ABody ByteSpan)
 -> Decoder
      s (Annotated (AHeader ByteSpan, ABody ByteSpan) ByteSpan))
-> Decoder s (AHeader ByteSpan, ABody ByteSpan)
-> Decoder
     s (Annotated (AHeader ByteSpan, ABody ByteSpan) ByteSpan)
forall a b. (a -> b) -> a -> b
$ do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Block" Int
3
    (,)
      (AHeader ByteSpan
 -> ABody ByteSpan -> (AHeader ByteSpan, ABody ByteSpan))
-> Decoder s (AHeader ByteSpan)
-> Decoder s (ABody ByteSpan -> (AHeader ByteSpan, ABody ByteSpan))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (AHeader ByteSpan)
forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots
      Decoder s (ABody ByteSpan -> (AHeader ByteSpan, ABody ByteSpan))
-> Decoder s (ABody ByteSpan)
-> Decoder s (AHeader ByteSpan, ABody ByteSpan)
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 (ABody ByteSpan)
forall s. Decoder s (ABody ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      -- Drop the deprecated ExtraBodyData
      Decoder s (AHeader ByteSpan, ABody ByteSpan)
-> Decoder s () -> Decoder s (AHeader ByteSpan, ABody ByteSpan)
forall a b. Decoder s a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ExtraBodyData" Int
1 Decoder s () -> Decoder s () -> Decoder s ()
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder s ()
forall s. Dropper s
dropEmptyAttributes)
  ABlock ByteSpan -> Decoder s (ABlock ByteSpan)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ABlock ByteSpan -> Decoder s (ABlock ByteSpan))
-> ABlock ByteSpan -> Decoder s (ABlock ByteSpan)
forall a b. (a -> b) -> a -> b
$ AHeader ByteSpan -> ABody ByteSpan -> ByteSpan -> ABlock ByteSpan
forall a. AHeader a -> ABody a -> a -> ABlock a
ABlock AHeader ByteSpan
header ABody ByteSpan
body ByteSpan
byteSpan

--------------------------------------------------------------------------------
-- Block Formatting
--------------------------------------------------------------------------------

instance B.Buildable (WithEpochSlots Block) where
  build :: WithEpochSlots Block -> Builder
build (WithEpochSlots EpochSlots
es Block
block) = EpochSlots -> Block -> Builder
renderBlock EpochSlots
es Block
block

renderBlock :: EpochSlots -> Block -> Builder
renderBlock :: EpochSlots -> Block -> Builder
renderBlock EpochSlots
es Block
block =
  Format
  Builder
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
-> WithEpochSlots (AHeader ())
-> Int
-> [Tx]
-> APayload ()
-> SscPayload
-> APayload ()
-> Builder
forall a. Format Builder a -> a
bprint
    ( Format
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
"Block:\n"
        Format
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
-> Format
     Builder
     (WithEpochSlots (AHeader ())
      -> Int
      -> [Tx]
      -> APayload ()
      -> SscPayload
      -> APayload ()
      -> Builder)
-> Format
     Builder
     (WithEpochSlots (AHeader ())
      -> Int
      -> [Tx]
      -> APayload ()
      -> SscPayload
      -> APayload ()
      -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
"  "
        Format
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
-> Format
     Builder
     (WithEpochSlots (AHeader ())
      -> Int
      -> [Tx]
      -> APayload ()
      -> SscPayload
      -> APayload ()
      -> Builder)
-> Format
     Builder
     (WithEpochSlots (AHeader ())
      -> Int
      -> [Tx]
      -> APayload ()
      -> SscPayload
      -> APayload ()
      -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
        Format
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (WithEpochSlots (AHeader ())
   -> Int
   -> [Tx]
   -> APayload ()
   -> SscPayload
   -> APayload ()
   -> Builder)
-> Format
     Builder
     (Int
      -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     (WithEpochSlots (AHeader ())
      -> Int
      -> [Tx]
      -> APayload ()
      -> SscPayload
      -> APayload ()
      -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
"  transactions ("
        Format
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     (Int
      -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     (Int
      -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall a r. Integral a => Format r (a -> r)
int
        Format
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  (Int
   -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     (Int
      -> [Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
" items): "
        Format
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
        Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder
     ([Tx] -> APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
"\n"
        Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
"  "
        Format
  (APayload () -> SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
        Format
  (SscPayload -> APayload () -> Builder)
  (APayload () -> SscPayload -> APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
-> Format
     Builder (APayload () -> SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SscPayload -> APayload () -> Builder)
  (SscPayload -> APayload () -> Builder)
"\n"
        Format
  (SscPayload -> APayload () -> Builder)
  (SscPayload -> APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SscPayload -> APayload () -> Builder)
  (SscPayload -> APayload () -> Builder)
"  "
        Format
  (SscPayload -> APayload () -> Builder)
  (SscPayload -> APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (APayload () -> Builder) (SscPayload -> APayload () -> Builder)
forall a r. Show a => Format r (a -> r)
shown
        Format
  (APayload () -> Builder) (SscPayload -> APayload () -> Builder)
-> Format Builder (APayload () -> Builder)
-> Format Builder (SscPayload -> APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (APayload () -> Builder) (APayload () -> Builder)
"\n"
        Format (APayload () -> Builder) (APayload () -> Builder)
-> Format Builder (APayload () -> Builder)
-> Format Builder (APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (APayload () -> Builder) (APayload () -> Builder)
"  update payload: "
        Format (APayload () -> Builder) (APayload () -> Builder)
-> Format Builder (APayload () -> Builder)
-> Format Builder (APayload () -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (APayload () -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
    )
    (EpochSlots -> AHeader () -> WithEpochSlots (AHeader ())
forall a. EpochSlots -> a -> WithEpochSlots a
WithEpochSlots EpochSlots
es (AHeader () -> WithEpochSlots (AHeader ()))
-> AHeader () -> WithEpochSlots (AHeader ())
forall a b. (a -> b) -> a -> b
$ Block -> AHeader ()
forall a. ABlock a -> AHeader a
blockHeader Block
block)
    ([Tx] -> Int
forall a. HasLength a => a -> Int
length [Tx]
txs)
    [Tx]
txs
    (Block -> APayload ()
forall a. ABlock a -> APayload a
blockDlgPayload Block
block)
    (Block -> SscPayload
forall a. ABlock a -> SscPayload
blockSscPayload Block
block)
    (Block -> APayload ()
forall a. ABlock a -> APayload a
blockUpdatePayload Block
block)
  where
    txs :: [Tx]
txs = ABody () -> [Tx]
bodyTxs (ABody () -> [Tx]) -> ABody () -> [Tx]
forall a b. (a -> b) -> a -> b
$ Block -> ABody ()
forall a. ABlock a -> ABody a
blockBody Block
block

--------------------------------------------------------------------------------
-- ABlockOrBoundary
--------------------------------------------------------------------------------

data ABlockOrBoundary a
  = ABOBBlock (ABlock a)
  | ABOBBoundary (ABoundaryBlock a)
  deriving (ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
(ABlockOrBoundary a -> ABlockOrBoundary a -> Bool)
-> (ABlockOrBoundary a -> ABlockOrBoundary a -> Bool)
-> Eq (ABlockOrBoundary a)
forall a. Eq a => ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
== :: ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
$c/= :: forall a. Eq a => ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
/= :: ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
Eq, (forall x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x)
-> (forall x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a)
-> Generic (ABlockOrBoundary a)
forall x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a
forall x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a
forall a x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x
$cfrom :: forall a x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x
from :: forall x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x
$cto :: forall a x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a
to :: forall x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a
Generic, Int -> ABlockOrBoundary a -> ShowS
[ABlockOrBoundary a] -> ShowS
ABlockOrBoundary a -> String
(Int -> ABlockOrBoundary a -> ShowS)
-> (ABlockOrBoundary a -> String)
-> ([ABlockOrBoundary a] -> ShowS)
-> Show (ABlockOrBoundary a)
forall a. Show a => Int -> ABlockOrBoundary a -> ShowS
forall a. Show a => [ABlockOrBoundary a] -> ShowS
forall a. Show a => ABlockOrBoundary a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABlockOrBoundary a -> ShowS
showsPrec :: Int -> ABlockOrBoundary a -> ShowS
$cshow :: forall a. Show a => ABlockOrBoundary a -> String
show :: ABlockOrBoundary a -> String
$cshowList :: forall a. Show a => [ABlockOrBoundary a] -> ShowS
showList :: [ABlockOrBoundary a] -> ShowS
Show, (forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b)
-> (forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a)
-> Functor ABlockOrBoundary
forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a
forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b
fmap :: forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b
$c<$ :: forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a
<$ :: forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a
Functor)

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABlockOrBoundary a)

-- | Encode a 'Block' accounting for deprecated epoch boundary blocks
encCBORABOBBlock :: EpochSlots -> ABlock a -> Encoding
encCBORABOBBlock :: forall a. EpochSlots -> ABlock a -> Encoding
encCBORABOBBlock EpochSlots
epochSlots ABlock a
block =
  Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word
1 :: Word)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochSlots -> Block -> Encoding
encCBORBlock EpochSlots
epochSlots ((a -> ()) -> ABlock a -> Block
forall a b. (a -> b) -> ABlock a -> ABlock b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> ()
forall a b. a -> b -> a
const ()) ABlock a
block)

-- | encCBORABoundaryBlock but with the list length and tag discriminator bytes.
encCBORABOBBoundary :: ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABOBBoundary :: forall a. ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABOBBoundary ProtocolMagicId
pm ABoundaryBlock a
bvd =
  Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word
0 :: Word)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolMagicId -> ABoundaryBlock a -> Encoding
forall a. ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABoundaryBlock ProtocolMagicId
pm ABoundaryBlock a
bvd

-- | Decode a 'Block' accounting for deprecated epoch boundary blocks
decCBORABOBBlock :: EpochSlots -> Decoder s (Maybe Block)
decCBORABOBBlock :: forall s. EpochSlots -> Decoder s (Maybe Block)
decCBORABOBBlock EpochSlots
epochSlots =
  EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
forall s. EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
decCBORABlockOrBoundary EpochSlots
epochSlots Decoder s (ABlockOrBoundary ByteSpan)
-> (ABlockOrBoundary ByteSpan -> Decoder s (Maybe Block))
-> Decoder s (Maybe Block)
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
    ABOBBoundary ABoundaryBlock ByteSpan
_ -> Maybe Block -> Decoder s (Maybe Block)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Block
forall a. Maybe a
Nothing
    ABOBBlock ABlock ByteSpan
b -> Maybe Block -> Decoder s (Maybe Block)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Block -> Decoder s (Maybe Block))
-> (Block -> Maybe Block) -> Block -> Decoder s (Maybe Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Block -> Maybe Block
forall a. a -> Maybe a
Just (Block -> Decoder s (Maybe Block))
-> Block -> Decoder s (Maybe Block)
forall a b. (a -> b) -> a -> b
$ ABlock ByteSpan -> Block
forall (f :: * -> *) a. Functor f => f a -> f ()
void ABlock ByteSpan
b

-- | Decode a 'Block' accounting for deprecated epoch boundary blocks
--
--   Previous versions of Cardano had an explicit boundary block between epochs.
--   A 'Block' was then represented as 'Either BoundaryBlock MainBlock'. We have
--   now deprecated these explicit boundary blocks, but we still need to decode
--   blocks in the old format. In the case that we find a boundary block, we
--   drop it using 'dropBoundaryBlock' and return a 'Nothing'.
decCBORABlockOrBoundary ::
  EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
decCBORABlockOrBoundary :: forall s. EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
decCBORABlockOrBoundary EpochSlots
epochSlots = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Block" Int
2
  forall a s. DecCBOR a => Decoder s a
decCBOR @Word Decoder s Word
-> (Word -> Decoder s (ABlockOrBoundary ByteSpan))
-> Decoder s (ABlockOrBoundary ByteSpan)
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
    Word
0 -> ABoundaryBlock ByteSpan -> ABlockOrBoundary ByteSpan
forall a. ABoundaryBlock a -> ABlockOrBoundary a
ABOBBoundary (ABoundaryBlock ByteSpan -> ABlockOrBoundary ByteSpan)
-> Decoder s (ABoundaryBlock ByteSpan)
-> Decoder s (ABlockOrBoundary ByteSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ABoundaryBlock ByteSpan)
forall s. Decoder s (ABoundaryBlock ByteSpan)
decCBORABoundaryBlock
    Word
1 -> ABlock ByteSpan -> ABlockOrBoundary ByteSpan
forall a. ABlock a -> ABlockOrBoundary a
ABOBBlock (ABlock ByteSpan -> ABlockOrBoundary ByteSpan)
-> Decoder s (ABlock ByteSpan)
-> Decoder s (ABlockOrBoundary ByteSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (ABlock ByteSpan)
forall s. EpochSlots -> Decoder s (ABlock ByteSpan)
decCBORABlock EpochSlots
epochSlots
    Word
t -> DecoderError -> Decoder s (ABlockOrBoundary ByteSpan)
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s (ABlockOrBoundary ByteSpan))
-> DecoderError -> Decoder s (ABlockOrBoundary ByteSpan)
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Block" (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)

encCBORABlockOrBoundary ::
  ProtocolMagicId -> EpochSlots -> ABlockOrBoundary a -> Encoding
encCBORABlockOrBoundary :: forall a.
ProtocolMagicId -> EpochSlots -> ABlockOrBoundary a -> Encoding
encCBORABlockOrBoundary ProtocolMagicId
pm EpochSlots
epochSlots ABlockOrBoundary a
abob = case ABlockOrBoundary a
abob of
  ABOBBlock ABlock a
blk -> EpochSlots -> ABlock a -> Encoding
forall a. EpochSlots -> ABlock a -> Encoding
encCBORABOBBlock EpochSlots
epochSlots ABlock a
blk
  ABOBBoundary ABoundaryBlock a
ebb -> ProtocolMagicId -> ABoundaryBlock a -> Encoding
forall a. ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABOBBoundary ProtocolMagicId
pm ABoundaryBlock a
ebb

--------------------------------------------------------------------------------
-- ABoundaryBlock
--------------------------------------------------------------------------------

-- | For boundary body data, we only keep an annotation. It's the body and
-- extra body data.
data ABoundaryBody a = ABoundaryBody
  { forall a. ABoundaryBody a -> a
boundaryBodyAnnotation :: !a
  }
  deriving (ABoundaryBody a -> ABoundaryBody a -> Bool
(ABoundaryBody a -> ABoundaryBody a -> Bool)
-> (ABoundaryBody a -> ABoundaryBody a -> Bool)
-> Eq (ABoundaryBody a)
forall a. Eq a => ABoundaryBody a -> ABoundaryBody a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ABoundaryBody a -> ABoundaryBody a -> Bool
== :: ABoundaryBody a -> ABoundaryBody a -> Bool
$c/= :: forall a. Eq a => ABoundaryBody a -> ABoundaryBody a -> Bool
/= :: ABoundaryBody a -> ABoundaryBody a -> Bool
Eq, (forall x. ABoundaryBody a -> Rep (ABoundaryBody a) x)
-> (forall x. Rep (ABoundaryBody a) x -> ABoundaryBody a)
-> Generic (ABoundaryBody a)
forall x. Rep (ABoundaryBody a) x -> ABoundaryBody a
forall x. ABoundaryBody a -> Rep (ABoundaryBody a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABoundaryBody a) x -> ABoundaryBody a
forall a x. ABoundaryBody a -> Rep (ABoundaryBody a) x
$cfrom :: forall a x. ABoundaryBody a -> Rep (ABoundaryBody a) x
from :: forall x. ABoundaryBody a -> Rep (ABoundaryBody a) x
$cto :: forall a x. Rep (ABoundaryBody a) x -> ABoundaryBody a
to :: forall x. Rep (ABoundaryBody a) x -> ABoundaryBody a
Generic, Int -> ABoundaryBody a -> ShowS
[ABoundaryBody a] -> ShowS
ABoundaryBody a -> String
(Int -> ABoundaryBody a -> ShowS)
-> (ABoundaryBody a -> String)
-> ([ABoundaryBody a] -> ShowS)
-> Show (ABoundaryBody a)
forall a. Show a => Int -> ABoundaryBody a -> ShowS
forall a. Show a => [ABoundaryBody a] -> ShowS
forall a. Show a => ABoundaryBody a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABoundaryBody a -> ShowS
showsPrec :: Int -> ABoundaryBody a -> ShowS
$cshow :: forall a. Show a => ABoundaryBody a -> String
show :: ABoundaryBody a -> String
$cshowList :: forall a. Show a => [ABoundaryBody a] -> ShowS
showList :: [ABoundaryBody a] -> ShowS
Show, (forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b)
-> (forall a b. a -> ABoundaryBody b -> ABoundaryBody a)
-> Functor ABoundaryBody
forall a b. a -> ABoundaryBody b -> ABoundaryBody a
forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b
fmap :: forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b
$c<$ :: forall a b. a -> ABoundaryBody b -> ABoundaryBody a
<$ :: forall a b. a -> ABoundaryBody b -> ABoundaryBody a
Functor)

instance Decoded (ABoundaryBody ByteString) where
  type BaseType (ABoundaryBody ByteString) = ABoundaryBody ()
  recoverBytes :: ABoundaryBody ByteString -> ByteString
recoverBytes = ABoundaryBody ByteString -> ByteString
forall a. ABoundaryBody a -> a
boundaryBodyAnnotation

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABoundaryBody a)

decCBORABoundaryBody :: Decoder s (ABoundaryBody ByteSpan)
decCBORABoundaryBody :: forall s. Decoder s (ABoundaryBody ByteSpan)
decCBORABoundaryBody = do
  Annotated ()
_ ByteSpan
bs <- Decoder s () -> Decoder s (Annotated () ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder (Decoder s () -> Decoder s (Annotated () ByteSpan))
-> Decoder s () -> Decoder s (Annotated () ByteSpan)
forall a b. (a -> b) -> a -> b
$ do
    Decoder s ()
forall s. Dropper s
dropBoundaryBody
    Decoder s ()
forall s. Dropper s
dropBoundaryExtraBodyData
  ABoundaryBody ByteSpan -> Decoder s (ABoundaryBody ByteSpan)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ABoundaryBody ByteSpan -> Decoder s (ABoundaryBody ByteSpan))
-> ABoundaryBody ByteSpan -> Decoder s (ABoundaryBody ByteSpan)
forall a b. (a -> b) -> a -> b
$ ByteSpan -> ABoundaryBody ByteSpan
forall a. a -> ABoundaryBody a
ABoundaryBody ByteSpan
bs

-- | Every boundary body has the same encoding: empty.
encCBORABoundaryBody :: ABoundaryBody a -> Encoding
encCBORABoundaryBody :: forall a. ABoundaryBody a -> Encoding
encCBORABoundaryBody ABoundaryBody a
_ =
  (Encoding
encodeListLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ( Word -> Encoding
encodeListLen Word
1
           Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Word8 LByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Map Word8 LByteString
forall a. Monoid a => a
mempty :: Map Word8 LByteString)
       )

-- | For a boundary block, we keep the header, body, and an annotation for
-- the whole thing (commonly the bytes from which it was decoded).
data ABoundaryBlock a = ABoundaryBlock
  { forall a. ABoundaryBlock a -> Int64
boundaryBlockLength :: !Int64
  -- ^ Needed for validation.
  , forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader :: !(ABoundaryHeader a)
  , forall a. ABoundaryBlock a -> ABoundaryBody a
boundaryBody :: !(ABoundaryBody a)
  , forall a. ABoundaryBlock a -> a
boundaryAnnotation :: !a
  }
  deriving (ABoundaryBlock a -> ABoundaryBlock a -> Bool
(ABoundaryBlock a -> ABoundaryBlock a -> Bool)
-> (ABoundaryBlock a -> ABoundaryBlock a -> Bool)
-> Eq (ABoundaryBlock a)
forall a. Eq a => ABoundaryBlock a -> ABoundaryBlock a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ABoundaryBlock a -> ABoundaryBlock a -> Bool
== :: ABoundaryBlock a -> ABoundaryBlock a -> Bool
$c/= :: forall a. Eq a => ABoundaryBlock a -> ABoundaryBlock a -> Bool
/= :: ABoundaryBlock a -> ABoundaryBlock a -> Bool
Eq, (forall x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x)
-> (forall x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a)
-> Generic (ABoundaryBlock a)
forall x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a
forall x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a
forall a x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x
$cfrom :: forall a x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x
from :: forall x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x
$cto :: forall a x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a
to :: forall x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a
Generic, Int -> ABoundaryBlock a -> ShowS
[ABoundaryBlock a] -> ShowS
ABoundaryBlock a -> String
(Int -> ABoundaryBlock a -> ShowS)
-> (ABoundaryBlock a -> String)
-> ([ABoundaryBlock a] -> ShowS)
-> Show (ABoundaryBlock a)
forall a. Show a => Int -> ABoundaryBlock a -> ShowS
forall a. Show a => [ABoundaryBlock a] -> ShowS
forall a. Show a => ABoundaryBlock a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABoundaryBlock a -> ShowS
showsPrec :: Int -> ABoundaryBlock a -> ShowS
$cshow :: forall a. Show a => ABoundaryBlock a -> String
show :: ABoundaryBlock a -> String
$cshowList :: forall a. Show a => [ABoundaryBlock a] -> ShowS
showList :: [ABoundaryBlock a] -> ShowS
Show, (forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b)
-> (forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a)
-> Functor ABoundaryBlock
forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a
forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b
fmap :: forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b
$c<$ :: forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a
<$ :: forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a
Functor)

instance Decoded (ABoundaryBlock ByteString) where
  type BaseType (ABoundaryBlock ByteString) = ABoundaryBlock ()
  recoverBytes :: ABoundaryBlock ByteString -> ByteString
recoverBytes = ABoundaryBlock ByteString -> ByteString
forall a. ABoundaryBlock a -> a
boundaryAnnotation

-- Used for debugging purposes only
instance ToJSON a => ToJSON (ABoundaryBlock a)

-- | Extract the hash of a boundary block from its annotation.
boundaryHashAnnotated :: ABoundaryBlock ByteString -> HeaderHash
boundaryHashAnnotated :: ABoundaryBlock ByteString -> HeaderHash
boundaryHashAnnotated = ABoundaryHeader ByteString -> HeaderHash
boundaryHeaderHashAnnotated (ABoundaryHeader ByteString -> HeaderHash)
-> (ABoundaryBlock ByteString -> ABoundaryHeader ByteString)
-> ABoundaryBlock ByteString
-> HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABoundaryBlock ByteString -> ABoundaryHeader ByteString
forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader

decCBORABoundaryBlock :: Decoder s (ABoundaryBlock ByteSpan)
decCBORABoundaryBlock :: forall s. Decoder s (ABoundaryBlock ByteSpan)
decCBORABoundaryBlock = do
  Annotated (ABoundaryHeader ByteSpan
hdr, ABoundaryBody ByteSpan
bod) bytespan :: ByteSpan
bytespan@(ByteSpan Int64
start Int64
end) <- Decoder s (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan)
-> Decoder
     s
     (Annotated
        (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan) ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder (Decoder s (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan)
 -> Decoder
      s
      (Annotated
         (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan) ByteSpan))
-> Decoder s (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan)
-> Decoder
     s
     (Annotated
        (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan) ByteSpan)
forall a b. (a -> b) -> a -> b
$ do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryBlock" Int
3
    -- 1 item (list of 5)
    ABoundaryHeader ByteSpan
hdr <- Decoder s (ABoundaryHeader ByteSpan)
forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader
    -- 2 items (body and extra body data)
    ABoundaryBody ByteSpan
bod <- Decoder s (ABoundaryBody ByteSpan)
forall s. Decoder s (ABoundaryBody ByteSpan)
decCBORABoundaryBody
    (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan)
-> Decoder s (ABoundaryHeader ByteSpan, ABoundaryBody ByteSpan)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ABoundaryHeader ByteSpan
hdr, ABoundaryBody ByteSpan
bod)
  ABoundaryBlock ByteSpan -> Decoder s (ABoundaryBlock ByteSpan)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ABoundaryBlock ByteSpan -> Decoder s (ABoundaryBlock ByteSpan))
-> ABoundaryBlock ByteSpan -> Decoder s (ABoundaryBlock ByteSpan)
forall a b. (a -> b) -> a -> b
$ ABoundaryBlock
      { boundaryBlockLength :: Int64
boundaryBlockLength = Int64
end Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
start
      , boundaryHeader :: ABoundaryHeader ByteSpan
boundaryHeader = ABoundaryHeader ByteSpan
hdr
      , boundaryBody :: ABoundaryBody ByteSpan
boundaryBody = ABoundaryBody ByteSpan
bod
      , boundaryAnnotation :: ByteSpan
boundaryAnnotation = ByteSpan
bytespan
      }

-- | See note on `encCBORABoundaryHeader`. This as well does not necessarily
-- invert the decoder `decCBORABoundaryBlock`.
encCBORABoundaryBlock :: ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABoundaryBlock :: forall a. ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABoundaryBlock ProtocolMagicId
pm ABoundaryBlock a
ebb =
  Word -> Encoding
encodeListLen Word
3
    -- 1 item (list of 5)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolMagicId -> ABoundaryHeader a -> Encoding
forall a. ProtocolMagicId -> ABoundaryHeader a -> Encoding
encCBORABoundaryHeader ProtocolMagicId
pm (ABoundaryBlock a -> ABoundaryHeader a
forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader ABoundaryBlock a
ebb)
    -- 2 items (body and extra body data)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ABoundaryBody a -> Encoding
forall a. ABoundaryBody a -> Encoding
encCBORABoundaryBody (ABoundaryBlock a -> ABoundaryBody a
forall a. ABoundaryBlock a -> ABoundaryBody a
boundaryBody ABoundaryBlock a
ebb)

instance B.Buildable (ABoundaryBlock a) where
  build :: ABoundaryBlock a -> Builder
build ABoundaryBlock a
bvd =
    Format
  Builder
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Word64
-> Either GenesisHash HeaderHash
-> ChainDifficulty
-> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
"Boundary:\n"
          Format
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Word64
      -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Word64
      -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
"  Starting epoch: "
          Format
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Word64
      -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Word64
      -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall a r. Integral a => Format r (a -> r)
int
          Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Word64
      -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
"\n"
          Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
"  "
          Format
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Either GenesisHash HeaderHash -> Builder)
-> Format
     (ChainDifficulty -> Builder)
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall a r. (a -> Builder) -> Format r (a -> r)
later Either GenesisHash HeaderHash -> Builder
buildBoundaryHash
          Format
  (ChainDifficulty -> Builder)
  (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
-> Format Builder (ChainDifficulty -> Builder)
-> Format
     Builder
     (Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (ChainDifficulty -> Builder) (ChainDifficulty -> Builder)
"\n"
          Format (ChainDifficulty -> Builder) (ChainDifficulty -> Builder)
-> Format Builder (ChainDifficulty -> Builder)
-> Format Builder (ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (ChainDifficulty -> Builder) (ChainDifficulty -> Builder)
"  Block number: "
          Format (ChainDifficulty -> Builder) (ChainDifficulty -> Builder)
-> Format Builder (ChainDifficulty -> Builder)
-> Format Builder (ChainDifficulty -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (ChainDifficulty -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
      )
      (ABoundaryHeader a -> Word64
forall a. ABoundaryHeader a -> Word64
boundaryEpoch ABoundaryHeader a
hdr)
      (ABoundaryHeader a -> Either GenesisHash HeaderHash
forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash ABoundaryHeader a
hdr)
      (ABoundaryHeader a -> ChainDifficulty
forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty ABoundaryHeader a
hdr)
    where
      hdr :: ABoundaryHeader a
hdr = ABoundaryBlock a -> ABoundaryHeader a
forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader ABoundaryBlock a
bvd
      buildBoundaryHash :: Either GenesisHash HeaderHash -> Builder
      buildBoundaryHash :: Either GenesisHash HeaderHash -> Builder
buildBoundaryHash (Left (GenesisHash Hash Raw
_)) = Text -> Builder
fromText Text
"Genesis"
      buildBoundaryHash (Right HeaderHash
h) = HeaderHash -> Builder
forall p. Buildable p => p -> Builder
B.build HeaderHash
h

-- | Compute the slot number assigned to a boundary block
boundaryBlockSlot ::
  EpochSlots ->
  -- | Epoch number
  Word64 ->
  SlotNumber
boundaryBlockSlot :: EpochSlots -> Word64 -> SlotNumber
boundaryBlockSlot (EpochSlots Word64
es) Word64
epoch =
  Word64 -> SlotNumber
SlotNumber (Word64 -> SlotNumber) -> Word64 -> SlotNumber
forall a b. (a -> b) -> a -> b
$ Word64
es Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
epoch

{-------------------------------------------------------------------------------
  Header of a regular block or EBB
-------------------------------------------------------------------------------}

data ABlockOrBoundaryHdr a
  = ABOBBlockHdr !(AHeader a)
  | ABOBBoundaryHdr !(ABoundaryHeader a)
  deriving (ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
(ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool)
-> (ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool)
-> Eq (ABlockOrBoundaryHdr a)
forall a.
Eq a =>
ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
== :: ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
$c/= :: forall a.
Eq a =>
ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
/= :: ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
Eq, Int -> ABlockOrBoundaryHdr a -> ShowS
[ABlockOrBoundaryHdr a] -> ShowS
ABlockOrBoundaryHdr a -> String
(Int -> ABlockOrBoundaryHdr a -> ShowS)
-> (ABlockOrBoundaryHdr a -> String)
-> ([ABlockOrBoundaryHdr a] -> ShowS)
-> Show (ABlockOrBoundaryHdr a)
forall a. Show a => Int -> ABlockOrBoundaryHdr a -> ShowS
forall a. Show a => [ABlockOrBoundaryHdr a] -> ShowS
forall a. Show a => ABlockOrBoundaryHdr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ABlockOrBoundaryHdr a -> ShowS
showsPrec :: Int -> ABlockOrBoundaryHdr a -> ShowS
$cshow :: forall a. Show a => ABlockOrBoundaryHdr a -> String
show :: ABlockOrBoundaryHdr a -> String
$cshowList :: forall a. Show a => [ABlockOrBoundaryHdr a] -> ShowS
showList :: [ABlockOrBoundaryHdr a] -> ShowS
Show, (forall a b.
 (a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b)
-> (forall a b.
    a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a)
-> Functor ABlockOrBoundaryHdr
forall a b. a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a
forall a b.
(a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b
fmap :: forall a b.
(a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b
$c<$ :: forall a b. a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a
<$ :: forall a b. a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a
Functor, (forall x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x)
-> (forall x.
    Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a)
-> Generic (ABlockOrBoundaryHdr a)
forall x. Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a
forall x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a
forall a x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x
$cfrom :: forall a x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x
from :: forall x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x
$cto :: forall a x. Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a
to :: forall x. Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a
Generic, Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
Proxy (ABlockOrBoundaryHdr a) -> String
(Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo))
-> (Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo))
-> (Proxy (ABlockOrBoundaryHdr a) -> String)
-> NoThunks (ABlockOrBoundaryHdr a)
forall a.
NoThunks a =>
Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (ABlockOrBoundaryHdr a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (ABlockOrBoundaryHdr a) -> String
showTypeOf :: Proxy (ABlockOrBoundaryHdr a) -> String
NoThunks)

decCBORABlockOrBoundaryHdr ::
  EpochSlots ->
  Decoder s (ABlockOrBoundaryHdr ByteSpan)
decCBORABlockOrBoundaryHdr :: forall s. EpochSlots -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
decCBORABlockOrBoundaryHdr EpochSlots
epochSlots = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ABlockOrBoundaryHdr" Int
2
  forall a s. DecCBOR a => Decoder s a
decCBOR @Word Decoder s Word
-> (Word -> Decoder s (ABlockOrBoundaryHdr ByteSpan))
-> Decoder s (ABlockOrBoundaryHdr ByteSpan)
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
    Word
0 -> ABoundaryHeader ByteSpan -> ABlockOrBoundaryHdr ByteSpan
forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr (ABoundaryHeader ByteSpan -> ABlockOrBoundaryHdr ByteSpan)
-> Decoder s (ABoundaryHeader ByteSpan)
-> Decoder s (ABlockOrBoundaryHdr ByteSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ABoundaryHeader ByteSpan)
forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader
    Word
1 -> AHeader ByteSpan -> ABlockOrBoundaryHdr ByteSpan
forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr (AHeader ByteSpan -> ABlockOrBoundaryHdr ByteSpan)
-> Decoder s (AHeader ByteSpan)
-> Decoder s (ABlockOrBoundaryHdr ByteSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochSlots -> Decoder s (AHeader ByteSpan)
forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots
    Word
t -> String -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (ABlockOrBoundaryHdr ByteSpan))
-> String -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag in encoded HeaderOrBoundary" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
t

-- | Encoder for 'ABlockOrBoundaryHdr' which is using the annotation.
-- It is right inverse of 'decCBORAblockOrBoundaryHdr'.
--
-- TODO: add a round trip test, e.g.
--
-- prop> decCBORABlockOrBoundaryHdr . encCBORABlockOrBoundaryHdr = id
--
-- which does not type check, but convey the meaning.
encCBORABlockOrBoundaryHdr :: ABlockOrBoundaryHdr ByteString -> Encoding
encCBORABlockOrBoundaryHdr :: ABlockOrBoundaryHdr ByteString -> Encoding
encCBORABlockOrBoundaryHdr ABlockOrBoundaryHdr ByteString
hdr =
  Word -> Encoding
encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> case ABlockOrBoundaryHdr ByteString
hdr of
      ABOBBoundaryHdr ABoundaryHeader ByteString
h ->
        Word -> Encoding
encodeWord Word
0
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (ABoundaryHeader ByteString -> ByteString
forall a. ABoundaryHeader a -> a
boundaryHeaderAnnotation ABoundaryHeader ByteString
h)
      ABOBBlockHdr AHeader ByteString
h ->
        Word -> Encoding
encodeWord Word
1
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (AHeader ByteString -> ByteString
forall a. AHeader a -> a
headerAnnotation AHeader ByteString
h)

-- | The size computation is compatible with 'encCBORABlockOrBoundaryHdr'
encCBORABlockOrBoundaryHdrSize :: Proxy (ABlockOrBoundaryHdr a) -> Size
encCBORABlockOrBoundaryHdrSize :: forall a. Proxy (ABlockOrBoundaryHdr a) -> Size
encCBORABlockOrBoundaryHdrSize Proxy (ABlockOrBoundaryHdr a)
hdr =
  Size
2 -- @encodeListLen 2@ followed by @encodeWord 0@ or @encodeWord 1@.
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
      [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"ABOBBoundaryHdr" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy ProtocolMagicId -> Proxy (ABoundaryHeader a) -> Size
forall a.
Proxy ProtocolMagicId -> Proxy (ABoundaryHeader a) -> Size
encCBORABoundaryHeaderSize Proxy ProtocolMagicId
forall {k} (t :: k). Proxy t
Proxy (ABoundaryHeader a -> ABlockOrBoundaryHdr a
forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr (ABoundaryHeader a -> ABlockOrBoundaryHdr a)
-> Proxy (ABlockOrBoundaryHdr a) -> Proxy (ABoundaryHeader a)
forall a' a. (a' -> a) -> Proxy a -> Proxy a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Proxy (ABlockOrBoundaryHdr a)
hdr)
      , Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"ABOBBlockHdr" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy EpochSlots -> Proxy (AHeader a) -> Size
forall a. Proxy EpochSlots -> Proxy (AHeader a) -> Size
encCBORHeaderSize Proxy EpochSlots
forall {k} (t :: k). Proxy t
Proxy (AHeader a -> ABlockOrBoundaryHdr a
forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr (AHeader a -> ABlockOrBoundaryHdr a)
-> Proxy (ABlockOrBoundaryHdr a) -> Proxy (AHeader a)
forall a' a. (a' -> a) -> Proxy a -> Proxy a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Proxy (ABlockOrBoundaryHdr a)
hdr)
      ]

-- | The analogue of 'Data.Either.either'
aBlockOrBoundaryHdr ::
  (AHeader a -> b) ->
  (ABoundaryHeader a -> b) ->
  ABlockOrBoundaryHdr a ->
  b
aBlockOrBoundaryHdr :: forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr AHeader a -> b
f ABoundaryHeader a -> b
_ (ABOBBlockHdr AHeader a
hdr) = AHeader a -> b
f AHeader a
hdr
aBlockOrBoundaryHdr AHeader a -> b
_ ABoundaryHeader a -> b
g (ABOBBoundaryHdr ABoundaryHeader a
hdr) = ABoundaryHeader a -> b
g ABoundaryHeader a
hdr

abobHdrFromBlock :: ABlockOrBoundary a -> ABlockOrBoundaryHdr a
abobHdrFromBlock :: forall a. ABlockOrBoundary a -> ABlockOrBoundaryHdr a
abobHdrFromBlock (ABOBBlock ABlock a
blk) = AHeader a -> ABlockOrBoundaryHdr a
forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr (AHeader a -> ABlockOrBoundaryHdr a)
-> AHeader a -> ABlockOrBoundaryHdr a
forall a b. (a -> b) -> a -> b
$ ABlock a -> AHeader a
forall a. ABlock a -> AHeader a
blockHeader ABlock a
blk
abobHdrFromBlock (ABOBBoundary ABoundaryBlock a
blk) = ABoundaryHeader a -> ABlockOrBoundaryHdr a
forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr (ABoundaryHeader a -> ABlockOrBoundaryHdr a)
-> ABoundaryHeader a -> ABlockOrBoundaryHdr a
forall a b. (a -> b) -> a -> b
$ ABoundaryBlock a -> ABoundaryHeader a
forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader ABoundaryBlock a
blk

-- | Slot number of the header
--
-- NOTE: Epoch slot number calculation must match the one in 'applyBoundary'.
abobHdrSlotNo :: EpochSlots -> ABlockOrBoundaryHdr a -> SlotNumber
abobHdrSlotNo :: forall a. EpochSlots -> ABlockOrBoundaryHdr a -> SlotNumber
abobHdrSlotNo EpochSlots
epochSlots =
  (AHeader a -> SlotNumber)
-> (ABoundaryHeader a -> SlotNumber)
-> ABlockOrBoundaryHdr a
-> SlotNumber
forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    AHeader a -> SlotNumber
forall a. AHeader a -> SlotNumber
headerSlot
    (EpochSlots -> Word64 -> SlotNumber
boundaryBlockSlot EpochSlots
epochSlots (Word64 -> SlotNumber)
-> (ABoundaryHeader a -> Word64) -> ABoundaryHeader a -> SlotNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABoundaryHeader a -> Word64
forall a. ABoundaryHeader a -> Word64
boundaryEpoch)

abobHdrChainDifficulty :: ABlockOrBoundaryHdr a -> ChainDifficulty
abobHdrChainDifficulty :: forall a. ABlockOrBoundaryHdr a -> ChainDifficulty
abobHdrChainDifficulty =
  (AHeader a -> ChainDifficulty)
-> (ABoundaryHeader a -> ChainDifficulty)
-> ABlockOrBoundaryHdr a
-> ChainDifficulty
forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    AHeader a -> ChainDifficulty
forall a. AHeader a -> ChainDifficulty
headerDifficulty
    ABoundaryHeader a -> ChainDifficulty
forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty

abobHdrHash :: ABlockOrBoundaryHdr ByteString -> HeaderHash
abobHdrHash :: ABlockOrBoundaryHdr ByteString -> HeaderHash
abobHdrHash (ABOBBoundaryHdr ABoundaryHeader ByteString
hdr) = ABoundaryHeader ByteString -> HeaderHash
boundaryHeaderHashAnnotated ABoundaryHeader ByteString
hdr
abobHdrHash (ABOBBlockHdr AHeader ByteString
hdr) = AHeader ByteString -> HeaderHash
headerHashAnnotated AHeader ByteString
hdr

abobHdrPrevHash :: ABlockOrBoundaryHdr a -> Maybe HeaderHash
abobHdrPrevHash :: forall a. ABlockOrBoundaryHdr a -> Maybe HeaderHash
abobHdrPrevHash =
  (AHeader a -> Maybe HeaderHash)
-> (ABoundaryHeader a -> Maybe HeaderHash)
-> ABlockOrBoundaryHdr a
-> Maybe HeaderHash
forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    (HeaderHash -> Maybe HeaderHash
forall a. a -> Maybe a
Just (HeaderHash -> Maybe HeaderHash)
-> (AHeader a -> HeaderHash) -> AHeader a -> Maybe HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AHeader a -> HeaderHash
forall a. AHeader a -> HeaderHash
headerPrevHash)
    ((GenesisHash -> Maybe HeaderHash)
-> (HeaderHash -> Maybe HeaderHash)
-> Either GenesisHash HeaderHash
-> Maybe HeaderHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe HeaderHash -> GenesisHash -> Maybe HeaderHash
forall a b. a -> b -> a
const Maybe HeaderHash
forall a. Maybe a
Nothing) HeaderHash -> Maybe HeaderHash
forall a. a -> Maybe a
Just (Either GenesisHash HeaderHash -> Maybe HeaderHash)
-> (ABoundaryHeader a -> Either GenesisHash HeaderHash)
-> ABoundaryHeader a
-> Maybe HeaderHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABoundaryHeader a -> Either GenesisHash HeaderHash
forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash)