{-# 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
forall a. Eq a => ABlock a -> ABlock a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABlock a -> ABlock a -> Bool
$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
Eq, Int -> ABlock a -> ShowS
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
showList :: [ABlock a] -> ShowS
$cshowList :: forall a. Show a => [ABlock a] -> ShowS
show :: ABlock a -> String
$cshow :: forall a. Show a => ABlock a -> String
showsPrec :: Int -> ABlock a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABlock a -> ShowS
Show, 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
$cto :: forall a x. Rep (ABlock a) x -> ABlock a
$cfrom :: forall a x. ABlock a -> Rep (ABlock a) x
Generic, forall a. NFData a => ABlock a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ABlock a -> ()
$crnf :: forall a. NFData a => ABlock a -> ()
NFData, 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
<$ :: forall a b. a -> ABlock b -> ABlock a
$c<$ :: forall a b. a -> ABlock b -> ABlock a
fmap :: forall a b. (a -> b) -> ABlock a -> ABlock b
$cfmap :: forall a b. (a -> b) -> ABlock a -> ABlock b
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 = 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 =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Word64 -> ChainDifficulty
ChainDifficulty Word64
0) (forall a. Enum a => a -> a
succ forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 =
  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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ABlock a -> AHeader a
blockHeader

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

blockLength :: ABlock ByteString -> Natural
blockLength :: ABlock ByteString -> Natural
blockLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
    forall a. Semigroup a => a -> a -> a
<> EpochSlots -> AHeader () -> Encoding
encCBORHeader EpochSlots
epochSlots (forall a. ABlock a -> AHeader a
blockHeader Block
block)
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. ABlock a -> ABody a
blockBody Block
block)
    forall a. Semigroup a => a -> a -> a
<> (Word -> Encoding
encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (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 <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Block" Int
3
    (,)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      -- Drop the deprecated ExtraBodyData
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ExtraBodyData" Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. Dropper s
dropEmptyAttributes)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 =
  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"
        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)
"  "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        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 ("
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int
        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): "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
        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"
        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)
"  "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
        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"
        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)
"  "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Show a => Format r (a -> r)
shown
        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"
        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: "
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
    )
    (forall a. EpochSlots -> a -> WithEpochSlots a
WithEpochSlots EpochSlots
es forall a b. (a -> b) -> a -> b
$ forall a. ABlock a -> AHeader a
blockHeader Block
block)
    (forall a. HasLength a => a -> Int
length [Tx]
txs)
    [Tx]
txs
    (forall a. ABlock a -> APayload a
blockDlgPayload Block
block)
    (forall a. ABlock a -> SscPayload
blockSscPayload Block
block)
    (forall a. ABlock a -> APayload a
blockUpdatePayload Block
block)
  where
    txs :: [Tx]
txs = ABody () -> [Tx]
bodyTxs forall a b. (a -> b) -> a -> b
$ 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
forall a. Eq a => ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABlockOrBoundary a -> ABlockOrBoundary a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (ABlockOrBoundary a) x -> ABlockOrBoundary a
$cfrom :: forall a x. ABlockOrBoundary a -> Rep (ABlockOrBoundary a) x
Generic, Int -> ABlockOrBoundary a -> ShowS
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
showList :: [ABlockOrBoundary a] -> ShowS
$cshowList :: forall a. Show a => [ABlockOrBoundary a] -> ShowS
show :: ABlockOrBoundary a -> String
$cshow :: forall a. Show a => ABlockOrBoundary a -> String
showsPrec :: Int -> ABlockOrBoundary a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABlockOrBoundary a -> ShowS
Show, 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
<$ :: forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a
$c<$ :: forall a b. a -> ABlockOrBoundary b -> ABlockOrBoundary a
fmap :: forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b
$cfmap :: forall a b. (a -> b) -> ABlockOrBoundary a -> ABlockOrBoundary b
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
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word
1 :: Word)
    forall a. Semigroup a => a -> a -> a
<> EpochSlots -> Block -> Encoding
encCBORBlock EpochSlots
epochSlots (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
    forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word
0 :: Word)
    forall a. Semigroup a => a -> a -> a
<> 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 =
  forall s. EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
decCBORABlockOrBoundary EpochSlots
epochSlots forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ABOBBoundary ABoundaryBlock ByteSpan
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    ABOBBlock ABlock ByteSpan
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Block" Int
2
  forall a s. DecCBOR a => Decoder s a
decCBOR @Word forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word
0 -> forall a. ABoundaryBlock a -> ABlockOrBoundary a
ABOBBoundary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s (ABoundaryBlock ByteSpan)
decCBORABoundaryBlock
    Word
1 -> forall a. ABlock a -> ABlockOrBoundary a
ABOBBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. EpochSlots -> Decoder s (ABlock ByteSpan)
decCBORABlock EpochSlots
epochSlots
    Word
t -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Block" (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 -> forall a. EpochSlots -> ABlock a -> Encoding
encCBORABOBBlock EpochSlots
epochSlots ABlock a
blk
  ABOBBoundary ABoundaryBlock a
ebb -> 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
forall a. Eq a => ABoundaryBody a -> ABoundaryBody a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABoundaryBody a -> ABoundaryBody a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (ABoundaryBody a) x -> ABoundaryBody a
$cfrom :: forall a x. ABoundaryBody a -> Rep (ABoundaryBody a) x
Generic, Int -> ABoundaryBody a -> ShowS
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
showList :: [ABoundaryBody a] -> ShowS
$cshowList :: forall a. Show a => [ABoundaryBody a] -> ShowS
show :: ABoundaryBody a -> String
$cshow :: forall a. Show a => ABoundaryBody a -> String
showsPrec :: Int -> ABoundaryBody a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABoundaryBody a -> ShowS
Show, 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
<$ :: forall a b. a -> ABoundaryBody b -> ABoundaryBody a
$c<$ :: forall a b. a -> ABoundaryBody b -> ABoundaryBody a
fmap :: forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b
$cfmap :: forall a b. (a -> b) -> ABoundaryBody a -> ABoundaryBody b
Functor)

instance Decoded (ABoundaryBody ByteString) where
  type BaseType (ABoundaryBody ByteString) = ABoundaryBody ()
  recoverBytes :: ABoundaryBody ByteString -> ByteString
recoverBytes = 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 <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
    forall s. Dropper s
dropBoundaryBody
    forall s. Dropper s
dropBoundaryExtraBodyData
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak)
    forall a. Semigroup a => a -> a -> a
<> ( Word -> Encoding
encodeListLen Word
1
          forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (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
forall a. Eq a => ABoundaryBlock a -> ABoundaryBlock a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABoundaryBlock a -> ABoundaryBlock a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (ABoundaryBlock a) x -> ABoundaryBlock a
$cfrom :: forall a x. ABoundaryBlock a -> Rep (ABoundaryBlock a) x
Generic, Int -> ABoundaryBlock a -> ShowS
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
showList :: [ABoundaryBlock a] -> ShowS
$cshowList :: forall a. Show a => [ABoundaryBlock a] -> ShowS
show :: ABoundaryBlock a -> String
$cshow :: forall a. Show a => ABoundaryBlock a -> String
showsPrec :: Int -> ABoundaryBlock a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABoundaryBlock a -> ShowS
Show, 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
<$ :: forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a
$c<$ :: forall a b. a -> ABoundaryBlock b -> ABoundaryBlock a
fmap :: forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b
$cfmap :: forall a b. (a -> b) -> ABoundaryBlock a -> ABoundaryBlock b
Functor)

instance Decoded (ABoundaryBlock ByteString) where
  type BaseType (ABoundaryBlock ByteString) = ABoundaryBlock ()
  recoverBytes :: ABoundaryBlock ByteString -> ByteString
recoverBytes = 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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) <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryBlock" Int
3
    -- 1 item (list of 5)
    ABoundaryHeader ByteSpan
hdr <- forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader
    -- 2 items (body and extra body data)
    ABoundaryBody ByteSpan
bod <- forall s. Decoder s (ABoundaryBody ByteSpan)
decCBORABoundaryBody
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (ABoundaryHeader ByteSpan
hdr, ABoundaryBody ByteSpan
bod)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ ABoundaryBlock
      { boundaryBlockLength :: Int64
boundaryBlockLength = Int64
end 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)
    forall a. Semigroup a => a -> a -> a
<> forall a. ProtocolMagicId -> ABoundaryHeader a -> Encoding
encCBORABoundaryHeader ProtocolMagicId
pm (forall a. ABoundaryBlock a -> ABoundaryHeader a
boundaryHeader ABoundaryBlock a
ebb)
    -- 2 items (body and extra body data)
    forall a. Semigroup a => a -> a -> a
<> forall a. ABoundaryBody a -> Encoding
encCBORABoundaryBody (forall a. ABoundaryBlock a -> ABoundaryBody a
boundaryBody ABoundaryBlock a
ebb)

instance B.Buildable (ABoundaryBlock a) where
  build :: ABoundaryBlock a -> Builder
build ABoundaryBlock a
bvd =
    forall a. Format Builder a -> a
bprint
      ( Format
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
  (Word64
   -> Either GenesisHash HeaderHash -> ChainDifficulty -> Builder)
"Boundary:\n"
          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: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Integral a => Format r (a -> r)
int
          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"
          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)
"  "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. (a -> Builder) -> Format r (a -> r)
later Either GenesisHash HeaderHash -> Builder
buildBoundaryHash
          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"
          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: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
      )
      (forall a. ABoundaryHeader a -> Word64
boundaryEpoch ABoundaryHeader a
hdr)
      (forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash ABoundaryHeader a
hdr)
      (forall a. ABoundaryHeader a -> ChainDifficulty
boundaryDifficulty ABoundaryHeader a
hdr)
    where
      hdr :: ABoundaryHeader a
hdr = 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) = 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 forall a b. (a -> b) -> a -> b
$ Word64
es 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
forall a.
Eq a =>
ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr a -> Bool
$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
Eq, Int -> ABlockOrBoundaryHdr a -> ShowS
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
showList :: [ABlockOrBoundaryHdr a] -> ShowS
$cshowList :: forall a. Show a => [ABlockOrBoundaryHdr a] -> ShowS
show :: ABlockOrBoundaryHdr a -> String
$cshow :: forall a. Show a => ABlockOrBoundaryHdr a -> String
showsPrec :: Int -> ABlockOrBoundaryHdr a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ABlockOrBoundaryHdr a -> ShowS
Show, 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
<$ :: forall a b. a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a
$c<$ :: forall a b. a -> ABlockOrBoundaryHdr b -> ABlockOrBoundaryHdr a
fmap :: forall a b.
(a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b
$cfmap :: forall a b.
(a -> b) -> ABlockOrBoundaryHdr a -> ABlockOrBoundaryHdr b
Functor, 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
$cto :: forall a x. Rep (ABlockOrBoundaryHdr a) x -> ABlockOrBoundaryHdr a
$cfrom :: forall a x. ABlockOrBoundaryHdr a -> Rep (ABlockOrBoundaryHdr a) x
Generic, 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
showTypeOf :: Proxy (ABlockOrBoundaryHdr a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (ABlockOrBoundaryHdr a) -> String
wNoThunks :: Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
noThunks :: Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> ABlockOrBoundaryHdr a -> IO (Maybe ThunkInfo)
NoThunks)

decCBORABlockOrBoundaryHdr ::
  EpochSlots ->
  Decoder s (ABlockOrBoundaryHdr ByteSpan)
decCBORABlockOrBoundaryHdr :: forall s. EpochSlots -> Decoder s (ABlockOrBoundaryHdr ByteSpan)
decCBORABlockOrBoundaryHdr EpochSlots
epochSlots = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ABlockOrBoundaryHdr" Int
2
  forall a s. DecCBOR a => Decoder s a
decCBOR @Word forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word
0 -> forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader
    Word
1 -> forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. EpochSlots -> Decoder s (AHeader ByteSpan)
decCBORAHeader EpochSlots
epochSlots
    Word
t -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown tag in encoded HeaderOrBoundary" forall a. Semigroup a => a -> a -> a
<> 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
    forall a. Semigroup a => a -> a -> a
<> case ABlockOrBoundaryHdr ByteString
hdr of
      ABOBBoundaryHdr ABoundaryHeader ByteString
h ->
        Word -> Encoding
encodeWord Word
0
          forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (forall a. ABoundaryHeader a -> a
boundaryHeaderAnnotation ABoundaryHeader ByteString
h)
      ABOBBlockHdr AHeader ByteString
h ->
        Word -> Encoding
encodeWord Word
1
          forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (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@.
    forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
      [ forall t. Text -> t -> Case t
Case Text
"ABOBBoundaryHdr" forall a b. (a -> b) -> a -> b
$ forall a.
Proxy ProtocolMagicId -> Proxy (ABoundaryHeader a) -> Size
encCBORABoundaryHeaderSize forall {k} (t :: k). Proxy t
Proxy (forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Proxy (ABlockOrBoundaryHdr a)
hdr)
      , forall t. Text -> t -> Case t
Case Text
"ABOBBlockHdr" forall a b. (a -> b) -> a -> b
$ forall a. Proxy EpochSlots -> Proxy (AHeader a) -> Size
encCBORHeaderSize forall {k} (t :: k). Proxy t
Proxy (forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr 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) = forall a. AHeader a -> ABlockOrBoundaryHdr a
ABOBBlockHdr forall a b. (a -> b) -> a -> b
$ forall a. ABlock a -> AHeader a
blockHeader ABlock a
blk
abobHdrFromBlock (ABOBBoundary ABoundaryBlock a
blk) = forall a. ABoundaryHeader a -> ABlockOrBoundaryHdr a
ABOBBoundaryHdr forall a b. (a -> b) -> a -> b
$ 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 =
  forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    forall a. AHeader a -> SlotNumber
headerSlot
    (EpochSlots -> Word64 -> SlotNumber
boundaryBlockSlot EpochSlots
epochSlots forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ABoundaryHeader a -> Word64
boundaryEpoch)

abobHdrChainDifficulty :: ABlockOrBoundaryHdr a -> ChainDifficulty
abobHdrChainDifficulty :: forall a. ABlockOrBoundaryHdr a -> ChainDifficulty
abobHdrChainDifficulty =
  forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    forall a. AHeader a -> ChainDifficulty
headerDifficulty
    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 =
  forall a b.
(AHeader a -> b)
-> (ABoundaryHeader a -> b) -> ABlockOrBoundaryHdr a -> b
aBlockOrBoundaryHdr
    (forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. AHeader a -> HeaderHash
headerPrevHash)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ABoundaryHeader a -> Either GenesisHash HeaderHash
boundaryPrevHash)