{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

-- | Blocks in the blockchain
module Cardano.Api.Block
  ( -- * Blocks in the context of an era
    Block (..)
  , pattern Block
  , BlockHeader (..)
  , getBlockHeader

    -- ** Blocks in the context of a consensus mode
  , BlockInMode (..)
  , fromConsensusBlock
  , toConsensusBlock

    -- * Points on the chain
  , ChainPoint (..)
  , SlotNo (..)
  , EpochNo (..)
  , toConsensusPoint
  , fromConsensusPoint
  , fromConsensusPointHF
  , toConsensusPointHF

    -- * Tip of the chain
  , ChainTip (..)
  , BlockNo (..)
  , chainTipToChainPoint
  , fromConsensusTip

    -- * Data family instances
  , Hash (..)
  , chainPointToHeaderHash
  , chainPointToSlotNo
  , makeChainTip
  )
where

import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.Modes
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Tx.Sign

import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.Hashing
import qualified Cardano.Ledger.Api as L
import qualified Cardano.Ledger.Block as Ledger
import qualified Cardano.Ledger.Era as Ledger
import           Cardano.Slotting.Block (BlockNo)
import           Cardano.Slotting.Slot (EpochNo, SlotNo, WithOrigin (..))
import qualified Ouroboros.Consensus.Block as Consensus
import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
import qualified Ouroboros.Consensus.Cardano.Block as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
import qualified Ouroboros.Consensus.Shelley.Protocol.Abstract as Consensus
import qualified Ouroboros.Network.Block as Consensus

import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import           Data.Foldable (Foldable (toList))
import           Data.String (IsString)
import           Data.Text (Text)

{- HLINT ignore "Use lambda" -}
{- HLINT ignore "Use lambda-case" -}

-- ----------------------------------------------------------------------------
-- Blocks in an era
--

-- | A blockchain block in a particular Cardano era.
data Block era where
  ByronBlock
    :: Consensus.ByronBlock
    -> Block ByronEra
  ShelleyBlock
    :: ShelleyBasedEra era
    -> Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
    -> Block era

-- | A block consists of a header and a body containing transactions.
pattern Block :: BlockHeader -> [Tx era] -> Block era
pattern $mBlock :: forall {r} {era}.
Block era -> (BlockHeader -> [Tx era] -> r) -> ((# #) -> r) -> r
Block header txs <- (getBlockHeaderAndTxs -> (header, txs))

{-# COMPLETE Block #-}

getBlockHeaderAndTxs :: Block era -> (BlockHeader, [Tx era])
getBlockHeaderAndTxs :: forall era. Block era -> (BlockHeader, [Tx era])
getBlockHeaderAndTxs Block era
block = (Block era -> BlockHeader
forall era. Block era -> BlockHeader
getBlockHeader Block era
block, Block era -> [Tx era]
forall era. Block era -> [Tx era]
getBlockTxs Block era
block)

-- The GADT in the ShelleyBlock case requires a custom instance
instance Show (Block era) where
  showsPrec :: Int -> Block era -> ShowS
showsPrec Int
p (ByronBlock ByronBlock
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ByronBlock "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByronBlock -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByronBlock
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraShelley ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraShelley "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> ShelleyBlock (TPraos StandardCrypto) StandardShelley -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (TPraos StandardCrypto) StandardShelley
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAllegra ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraAllegra "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> ShelleyBlock (TPraos StandardCrypto) StandardAllegra -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (TPraos StandardCrypto) StandardAllegra
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraMary ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraMary "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyBlock (TPraos StandardCrypto) StandardMary -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (TPraos StandardCrypto) StandardMary
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAlonzo ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraAlonzo "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyBlock (TPraos StandardCrypto) StandardAlonzo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (TPraos StandardCrypto) StandardAlonzo
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraBabbage ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraBabbage "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyBlock (Praos StandardCrypto) StandardBabbage -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (Praos StandardCrypto) StandardBabbage
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )
  showsPrec Int
p (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraConway ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ( String -> ShowS
showString String
"ShelleyBlock ShelleyBasedEraConway "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShelleyBlock (Praos StandardCrypto) StandardConway -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShelleyBlock (Praos StandardCrypto) StandardConway
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
      )

getBlockTxs :: forall era. Block era -> [Tx era]
getBlockTxs :: forall era. Block era -> [Tx era]
getBlockTxs = \case
  -- In the context of foldBlocks we don't care about the Byron era.
  -- Testing leans on ledger events which is a Shelley onwards feature.
  ByronBlock Consensus.ByronBlock{} -> []
  ShelleyBlock ShelleyBasedEra era
sbe Consensus.ShelleyBlock{Block
  (ShelleyProtocolHeader (ConsensusProtocol era))
  (ShelleyLedgerEra era)
shelleyBlockRaw :: Block
  (ShelleyProtocolHeader (ConsensusProtocol era))
  (ShelleyLedgerEra era)
shelleyBlockRaw :: forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
Consensus.shelleyBlockRaw} ->
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => [Tx era]) -> [Tx era]
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => [Tx era]) -> [Tx era])
-> (ShelleyBasedEraConstraints era => [Tx era]) -> [Tx era]
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> Block
     (ShelleyProtocolHeader (ConsensusProtocol era))
     (ShelleyLedgerEra era)
-> [Tx era]
forall era ledgerera blockheader.
(ShelleyLedgerEra era ~ ledgerera,
 ShelleyCompatible (ConsensusProtocol era) ledgerera,
 ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader) =>
ShelleyBasedEra era -> Block blockheader ledgerera -> [Tx era]
getShelleyBlockTxs ShelleyBasedEra era
sbe Block
  (ShelleyProtocolHeader (ConsensusProtocol era))
  (ShelleyLedgerEra era)
shelleyBlockRaw

getShelleyBlockTxs
  :: forall era ledgerera blockheader
   . ShelleyLedgerEra era ~ ledgerera
  => Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
  => Consensus.ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader
  => ShelleyBasedEra era
  -> Ledger.Block blockheader ledgerera
  -> [Tx era]
getShelleyBlockTxs :: forall era ledgerera blockheader.
(ShelleyLedgerEra era ~ ledgerera,
 ShelleyCompatible (ConsensusProtocol era) ledgerera,
 ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader) =>
ShelleyBasedEra era -> Block blockheader ledgerera -> [Tx era]
getShelleyBlockTxs ShelleyBasedEra era
era (Ledger.Block blockheader
_header TxSeq ledgerera
txs) =
  [ ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
era Tx ledgerera
Tx (ShelleyLedgerEra era)
txinblock
  | Tx ledgerera
txinblock <- StrictSeq (Tx ledgerera) -> [Tx ledgerera]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxSeq ledgerera -> StrictSeq (Tx ledgerera)
forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
Ledger.fromTxSeq TxSeq ledgerera
txs)
  ]

-- ----------------------------------------------------------------------------
-- Block in a consensus mode
--

-- | A 'Block' in one of the eras.
-- TODO Rename this to BlockInEra
data BlockInMode where
  BlockInMode
    :: CardanoEra era
    -> Block era
    -> BlockInMode

deriving instance Show BlockInMode

fromConsensusBlock
  :: ()
  => Consensus.CardanoBlock L.StandardCrypto ~ block
  => block
  -> BlockInMode
fromConsensusBlock :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
block -> BlockInMode
fromConsensusBlock = \case
  Consensus.BlockByron ByronBlock
b' -> CardanoEra ByronEra -> Block ByronEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra ByronEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block ByronEra -> BlockInMode) -> Block ByronEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ByronBlock -> Block ByronEra
ByronBlock ByronBlock
b'
  Consensus.BlockShelley ShelleyBlock (TPraos StandardCrypto) StandardShelley
b' -> CardanoEra ShelleyEra -> Block ShelleyEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra ShelleyEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block ShelleyEra -> BlockInMode)
-> Block ShelleyEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra
-> ShelleyBlock
     (ConsensusProtocol ShelleyEra) (ShelleyLedgerEra ShelleyEra)
-> Block ShelleyEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley ShelleyBlock (TPraos StandardCrypto) StandardShelley
ShelleyBlock
  (ConsensusProtocol ShelleyEra) (ShelleyLedgerEra ShelleyEra)
b'
  Consensus.BlockAllegra ShelleyBlock (TPraos StandardCrypto) StandardAllegra
b' -> CardanoEra AllegraEra -> Block AllegraEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra AllegraEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block AllegraEra -> BlockInMode)
-> Block AllegraEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra
-> ShelleyBlock
     (ConsensusProtocol AllegraEra) (ShelleyLedgerEra AllegraEra)
-> Block AllegraEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra ShelleyBlock (TPraos StandardCrypto) StandardAllegra
ShelleyBlock
  (ConsensusProtocol AllegraEra) (ShelleyLedgerEra AllegraEra)
b'
  Consensus.BlockMary ShelleyBlock (TPraos StandardCrypto) StandardMary
b' -> CardanoEra MaryEra -> Block MaryEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra MaryEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block MaryEra -> BlockInMode) -> Block MaryEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra
-> ShelleyBlock
     (ConsensusProtocol MaryEra) (ShelleyLedgerEra MaryEra)
-> Block MaryEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra MaryEra
ShelleyBasedEraMary ShelleyBlock (TPraos StandardCrypto) StandardMary
ShelleyBlock (ConsensusProtocol MaryEra) (ShelleyLedgerEra MaryEra)
b'
  Consensus.BlockAlonzo ShelleyBlock (TPraos StandardCrypto) StandardAlonzo
b' -> CardanoEra AlonzoEra -> Block AlonzoEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra AlonzoEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block AlonzoEra -> BlockInMode) -> Block AlonzoEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra
-> ShelleyBlock
     (ConsensusProtocol AlonzoEra) (ShelleyLedgerEra AlonzoEra)
-> Block AlonzoEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo ShelleyBlock (TPraos StandardCrypto) StandardAlonzo
ShelleyBlock
  (ConsensusProtocol AlonzoEra) (ShelleyLedgerEra AlonzoEra)
b'
  Consensus.BlockBabbage ShelleyBlock (Praos StandardCrypto) StandardBabbage
b' -> CardanoEra BabbageEra -> Block BabbageEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra BabbageEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block BabbageEra -> BlockInMode)
-> Block BabbageEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra
-> ShelleyBlock
     (ConsensusProtocol BabbageEra) (ShelleyLedgerEra BabbageEra)
-> Block BabbageEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage ShelleyBlock (Praos StandardCrypto) StandardBabbage
ShelleyBlock
  (ConsensusProtocol BabbageEra) (ShelleyLedgerEra BabbageEra)
b'
  Consensus.BlockConway ShelleyBlock (Praos StandardCrypto) StandardConway
b' -> CardanoEra ConwayEra -> Block ConwayEra -> BlockInMode
forall era. CardanoEra era -> Block era -> BlockInMode
BlockInMode CardanoEra ConwayEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra (Block ConwayEra -> BlockInMode) -> Block ConwayEra -> BlockInMode
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra
-> ShelleyBlock
     (ConsensusProtocol ConwayEra) (ShelleyLedgerEra ConwayEra)
-> Block ConwayEra
forall era.
ShelleyBasedEra era
-> ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> Block era
ShelleyBlock ShelleyBasedEra ConwayEra
ShelleyBasedEraConway ShelleyBlock (Praos StandardCrypto) StandardConway
ShelleyBlock
  (ConsensusProtocol ConwayEra) (ShelleyLedgerEra ConwayEra)
b'

toConsensusBlock
  :: ()
  => Consensus.CardanoBlock L.StandardCrypto ~ block
  => BlockInMode
  -> block
toConsensusBlock :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
BlockInMode -> block
toConsensusBlock = \case
  BlockInMode CardanoEra era
_ (ByronBlock ByronBlock
b') -> ByronBlock -> CardanoBlock StandardCrypto
forall c. ByronBlock -> CardanoBlock c
Consensus.BlockByron ByronBlock
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraShelley ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (TPraos StandardCrypto) StandardShelley
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (TPraos c) (ShelleyEra c) -> CardanoBlock c
Consensus.BlockShelley ShelleyBlock (TPraos StandardCrypto) StandardShelley
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAllegra ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (TPraos StandardCrypto) StandardAllegra
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (TPraos c) (AllegraEra c) -> CardanoBlock c
Consensus.BlockAllegra ShelleyBlock (TPraos StandardCrypto) StandardAllegra
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraMary ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (TPraos StandardCrypto) StandardMary
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (TPraos c) (MaryEra c) -> CardanoBlock c
Consensus.BlockMary ShelleyBlock (TPraos StandardCrypto) StandardMary
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAlonzo ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (TPraos StandardCrypto) StandardAlonzo
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (TPraos c) (AlonzoEra c) -> CardanoBlock c
Consensus.BlockAlonzo ShelleyBlock (TPraos StandardCrypto) StandardAlonzo
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraBabbage ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (Praos StandardCrypto) StandardBabbage
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (Praos c) (BabbageEra c) -> CardanoBlock c
Consensus.BlockBabbage ShelleyBlock (Praos StandardCrypto) StandardBabbage
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'
  BlockInMode CardanoEra era
_ (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraConway ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') -> ShelleyBlock (Praos StandardCrypto) StandardConway
-> CardanoBlock StandardCrypto
forall c. ShelleyBlock (Praos c) (ConwayEra c) -> CardanoBlock c
Consensus.BlockConway ShelleyBlock (Praos StandardCrypto) StandardConway
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'

-- ----------------------------------------------------------------------------
-- Block headers
--

data BlockHeader
  = BlockHeader
      !SlotNo
      !(Hash BlockHeader)
      !BlockNo

-- | For now at least we use a fixed concrete hash type for all modes and era.
-- The different eras do use different types, but it's all the same underlying
-- representation.
newtype instance Hash BlockHeader = HeaderHash SBS.ShortByteString
  deriving (Hash BlockHeader -> Hash BlockHeader -> Bool
(Hash BlockHeader -> Hash BlockHeader -> Bool)
-> (Hash BlockHeader -> Hash BlockHeader -> Bool)
-> Eq (Hash BlockHeader)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash BlockHeader -> Hash BlockHeader -> Bool
== :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c/= :: Hash BlockHeader -> Hash BlockHeader -> Bool
/= :: Hash BlockHeader -> Hash BlockHeader -> Bool
Eq, Eq (Hash BlockHeader)
Eq (Hash BlockHeader) =>
(Hash BlockHeader -> Hash BlockHeader -> Ordering)
-> (Hash BlockHeader -> Hash BlockHeader -> Bool)
-> (Hash BlockHeader -> Hash BlockHeader -> Bool)
-> (Hash BlockHeader -> Hash BlockHeader -> Bool)
-> (Hash BlockHeader -> Hash BlockHeader -> Bool)
-> (Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader)
-> (Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader)
-> Ord (Hash BlockHeader)
Hash BlockHeader -> Hash BlockHeader -> Bool
Hash BlockHeader -> Hash BlockHeader -> Ordering
Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash BlockHeader -> Hash BlockHeader -> Ordering
compare :: Hash BlockHeader -> Hash BlockHeader -> Ordering
$c< :: Hash BlockHeader -> Hash BlockHeader -> Bool
< :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c<= :: Hash BlockHeader -> Hash BlockHeader -> Bool
<= :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c> :: Hash BlockHeader -> Hash BlockHeader -> Bool
> :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c>= :: Hash BlockHeader -> Hash BlockHeader -> Bool
>= :: Hash BlockHeader -> Hash BlockHeader -> Bool
$cmax :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
max :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
$cmin :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
min :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
Ord, Int -> Hash BlockHeader -> ShowS
[Hash BlockHeader] -> ShowS
Hash BlockHeader -> String
(Int -> Hash BlockHeader -> ShowS)
-> (Hash BlockHeader -> String)
-> ([Hash BlockHeader] -> ShowS)
-> Show (Hash BlockHeader)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash BlockHeader -> ShowS
showsPrec :: Int -> Hash BlockHeader -> ShowS
$cshow :: Hash BlockHeader -> String
show :: Hash BlockHeader -> String
$cshowList :: [Hash BlockHeader] -> ShowS
showList :: [Hash BlockHeader] -> ShowS
Show)
  deriving ([Hash BlockHeader] -> Value
[Hash BlockHeader] -> Encoding
Hash BlockHeader -> Bool
Hash BlockHeader -> Value
Hash BlockHeader -> Encoding
(Hash BlockHeader -> Value)
-> (Hash BlockHeader -> Encoding)
-> ([Hash BlockHeader] -> Value)
-> ([Hash BlockHeader] -> Encoding)
-> (Hash BlockHeader -> Bool)
-> ToJSON (Hash BlockHeader)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Hash BlockHeader -> Value
toJSON :: Hash BlockHeader -> Value
$ctoEncoding :: Hash BlockHeader -> Encoding
toEncoding :: Hash BlockHeader -> Encoding
$ctoJSONList :: [Hash BlockHeader] -> Value
toJSONList :: [Hash BlockHeader] -> Value
$ctoEncodingList :: [Hash BlockHeader] -> Encoding
toEncodingList :: [Hash BlockHeader] -> Encoding
$comitField :: Hash BlockHeader -> Bool
omitField :: Hash BlockHeader -> Bool
ToJSON, Maybe (Hash BlockHeader)
Value -> Parser [Hash BlockHeader]
Value -> Parser (Hash BlockHeader)
(Value -> Parser (Hash BlockHeader))
-> (Value -> Parser [Hash BlockHeader])
-> Maybe (Hash BlockHeader)
-> FromJSON (Hash BlockHeader)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Hash BlockHeader)
parseJSON :: Value -> Parser (Hash BlockHeader)
$cparseJSONList :: Value -> Parser [Hash BlockHeader]
parseJSONList :: Value -> Parser [Hash BlockHeader]
$comittedField :: Maybe (Hash BlockHeader)
omittedField :: Maybe (Hash BlockHeader)
FromJSON) via UsingRawBytesHex (Hash BlockHeader)
  deriving String -> Hash BlockHeader
(String -> Hash BlockHeader) -> IsString (Hash BlockHeader)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash BlockHeader
fromString :: String -> Hash BlockHeader
IsString via UsingRawBytesHex (Hash BlockHeader)

instance SerialiseAsRawBytes (Hash BlockHeader) where
  serialiseToRawBytes :: Hash BlockHeader -> ByteString
serialiseToRawBytes (HeaderHash ShortByteString
bs) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
bs

  deserialiseFromRawBytes :: AsType (Hash BlockHeader)
-> ByteString -> Either SerialiseAsRawBytesError (Hash BlockHeader)
deserialiseFromRawBytes (AsHash AsType BlockHeader
R:AsTypeBlockHeader
AsBlockHeader) ByteString
bs
    | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = Hash BlockHeader
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall a b. b -> Either a b
Right (Hash BlockHeader
 -> Either SerialiseAsRawBytesError (Hash BlockHeader))
-> Hash BlockHeader
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$! ShortByteString -> Hash BlockHeader
HeaderHash (ByteString -> ShortByteString
SBS.toShort ByteString
bs)
    | Bool
otherwise = SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError (Hash BlockHeader)
forall a b. a -> Either a b
Left (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash BlockHeader")

instance HasTypeProxy BlockHeader where
  data AsType BlockHeader = AsBlockHeader
  proxyToAsType :: Proxy BlockHeader -> AsType BlockHeader
proxyToAsType Proxy BlockHeader
_ = AsType BlockHeader
AsBlockHeader

getBlockHeader
  :: forall era. Block era -> BlockHeader
getBlockHeader :: forall era. Block era -> BlockHeader
getBlockHeader = \case
  ShelleyBlock ShelleyBasedEra era
sbe ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block ->
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => BlockHeader) -> BlockHeader
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => BlockHeader) -> BlockHeader)
-> (ShelleyBasedEraConstraints era => BlockHeader) -> BlockHeader
forall a b. (a -> b) -> a -> b
$
      let Consensus.HeaderFields
            { headerFieldHash :: forall k (b :: k). HeaderFields b -> HeaderHash b
Consensus.headerFieldHash =
              Consensus.ShelleyHash (Crypto.UnsafeHash ShortByteString
hashSBS)
            , SlotNo
headerFieldSlot :: SlotNo
headerFieldSlot :: forall k (b :: k). HeaderFields b -> SlotNo
Consensus.headerFieldSlot
            , BlockNo
headerFieldBlockNo :: BlockNo
headerFieldBlockNo :: forall k (b :: k). HeaderFields b -> BlockNo
Consensus.headerFieldBlockNo
            } = ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
-> HeaderFields
     (ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
forall b. HasHeader b => b -> HeaderFields b
Consensus.getHeaderFields ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block
       in SlotNo -> Hash BlockHeader -> BlockNo -> BlockHeader
BlockHeader SlotNo
headerFieldSlot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
hashSBS) BlockNo
headerFieldBlockNo
  ByronBlock ByronBlock
block ->
    SlotNo -> Hash BlockHeader -> BlockNo -> BlockHeader
BlockHeader
      SlotNo
headerFieldSlot
      (ShortByteString -> Hash BlockHeader
HeaderHash (ShortByteString -> Hash BlockHeader)
-> ShortByteString -> Hash BlockHeader
forall a b. (a -> b) -> a -> b
$ AbstractHash Blake2b_256 Header -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
Cardano.Crypto.Hashing.abstractHashToShort AbstractHash Blake2b_256 Header
byronHeaderHash)
      BlockNo
headerFieldBlockNo
   where
    Consensus.HeaderFields
      { headerFieldHash :: forall k (b :: k). HeaderFields b -> HeaderHash b
Consensus.headerFieldHash = Consensus.ByronHash AbstractHash Blake2b_256 Header
byronHeaderHash
      , SlotNo
headerFieldSlot :: forall k (b :: k). HeaderFields b -> SlotNo
headerFieldSlot :: SlotNo
Consensus.headerFieldSlot
      , BlockNo
headerFieldBlockNo :: forall k (b :: k). HeaderFields b -> BlockNo
headerFieldBlockNo :: BlockNo
Consensus.headerFieldBlockNo
      } = ByronBlock -> HeaderFields ByronBlock
forall b. HasHeader b => b -> HeaderFields b
Consensus.getHeaderFields ByronBlock
block

-- ----------------------------------------------------------------------------
-- Chain points
--

data ChainPoint
  = ChainPointAtGenesis
  | ChainPoint !SlotNo !(Hash BlockHeader)
  deriving (ChainPoint -> ChainPoint -> Bool
(ChainPoint -> ChainPoint -> Bool)
-> (ChainPoint -> ChainPoint -> Bool) -> Eq ChainPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainPoint -> ChainPoint -> Bool
== :: ChainPoint -> ChainPoint -> Bool
$c/= :: ChainPoint -> ChainPoint -> Bool
/= :: ChainPoint -> ChainPoint -> Bool
Eq, Int -> ChainPoint -> ShowS
[ChainPoint] -> ShowS
ChainPoint -> String
(Int -> ChainPoint -> ShowS)
-> (ChainPoint -> String)
-> ([ChainPoint] -> ShowS)
-> Show ChainPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainPoint -> ShowS
showsPrec :: Int -> ChainPoint -> ShowS
$cshow :: ChainPoint -> String
show :: ChainPoint -> String
$cshowList :: [ChainPoint] -> ShowS
showList :: [ChainPoint] -> ShowS
Show)

instance Ord ChainPoint where
  compare :: ChainPoint -> ChainPoint -> Ordering
compare ChainPoint
ChainPointAtGenesis ChainPoint
ChainPointAtGenesis = Ordering
EQ
  compare ChainPoint
ChainPointAtGenesis ChainPoint
_ = Ordering
LT
  compare ChainPoint
_ ChainPoint
ChainPointAtGenesis = Ordering
GT
  compare (ChainPoint SlotNo
sn Hash BlockHeader
_) (ChainPoint SlotNo
sn' Hash BlockHeader
_) = SlotNo -> SlotNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SlotNo
sn SlotNo
sn'

instance ToJSON ChainPoint where
  toJSON :: ChainPoint -> Value
toJSON = \case
    ChainPoint
ChainPointAtGenesis -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainPointAtGenesis"]
    ChainPoint SlotNo
slot Hash BlockHeader
blockHash ->
      [Pair] -> Value
object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"ChainPoint"
        , Key
"slot" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON SlotNo
slot
        , Key
"blockHash" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Hash BlockHeader -> Value
forall a. ToJSON a => a -> Value
toJSON Hash BlockHeader
blockHash
        ]

instance FromJSON ChainPoint where
  parseJSON :: Value -> Parser ChainPoint
parseJSON = String
-> (Object -> Parser ChainPoint) -> Value -> Parser ChainPoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ChainPoint" ((Object -> Parser ChainPoint) -> Value -> Parser ChainPoint)
-> (Object -> Parser ChainPoint) -> Value -> Parser ChainPoint
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
tag <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case Text
tag :: Text of
      Text
"ChainPointAtGenesis" -> ChainPoint -> Parser ChainPoint
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainPoint
ChainPointAtGenesis
      Text
"ChainPoint" -> SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint (SlotNo -> Hash BlockHeader -> ChainPoint)
-> Parser SlotNo -> Parser (Hash BlockHeader -> ChainPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SlotNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot" Parser (Hash BlockHeader -> ChainPoint)
-> Parser (Hash BlockHeader) -> Parser ChainPoint
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Hash BlockHeader)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blockHash"
      Text
_ -> String -> Parser ChainPoint
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected tag to be ChainPointAtGenesis | ChainPoint"

-- | Convert a 'Consensus.Point' for multi-era block type
toConsensusPointHF
  :: Consensus.HeaderHash block ~ Consensus.OneEraHash xs
  => ChainPoint -> Consensus.Point block
toConsensusPointHF :: forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
ChainPoint -> Point block
toConsensusPointHF ChainPoint
ChainPointAtGenesis = Point block
forall {k} (block :: k). Point block
Consensus.GenesisPoint
toConsensusPointHF (ChainPoint SlotNo
slot (HeaderHash ShortByteString
h)) =
  SlotNo -> HeaderHash block -> Point block
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
Consensus.BlockPoint SlotNo
slot (ShortByteString -> OneEraHash xs
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
Consensus.OneEraHash ShortByteString
h)

-- | Convert a 'Consensus.Point' for multi-era block type
fromConsensusPointHF
  :: Consensus.HeaderHash block ~ Consensus.OneEraHash xs
  => Consensus.Point block -> ChainPoint
fromConsensusPointHF :: forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF Point block
Consensus.GenesisPoint = ChainPoint
ChainPointAtGenesis
fromConsensusPointHF (Consensus.BlockPoint SlotNo
slot (Consensus.OneEraHash ShortByteString
h)) =
  SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
h)

-- | Convert a 'Consensus.Point' for single Shelley-era block type
toConsensusPoint
  :: forall ledgerera protocol
   . Consensus.ShelleyCompatible protocol ledgerera
  => ChainPoint
  -> Consensus.Point (Consensus.ShelleyBlock protocol ledgerera)
toConsensusPoint :: forall ledgerera protocol.
ShelleyCompatible protocol ledgerera =>
ChainPoint -> Point (ShelleyBlock protocol ledgerera)
toConsensusPoint ChainPoint
ChainPointAtGenesis = Point (ShelleyBlock protocol ledgerera)
forall {k} (block :: k). Point block
Consensus.GenesisPoint
toConsensusPoint (ChainPoint SlotNo
slot (HeaderHash ShortByteString
h)) =
  SlotNo
-> HeaderHash (ShelleyBlock protocol ledgerera)
-> Point (ShelleyBlock protocol ledgerera)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
Consensus.BlockPoint SlotNo
slot (Proxy (ShelleyBlock protocol ledgerera)
-> ShortByteString -> HeaderHash (ShelleyBlock protocol ledgerera)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy (ShelleyBlock protocol ledgerera)
-> ShortByteString -> HeaderHash (ShelleyBlock protocol ledgerera)
Consensus.fromShortRawHash Proxy (ShelleyBlock protocol ledgerera)
proxy ShortByteString
h)
 where
  proxy :: Proxy (Consensus.ShelleyBlock protocol ledgerera)
  proxy :: Proxy (ShelleyBlock protocol ledgerera)
proxy = Proxy (ShelleyBlock protocol ledgerera)
forall {k} (t :: k). Proxy t
Proxy

-- | Convert a 'Consensus.Point' for single Shelley-era block type
fromConsensusPoint
  :: forall protocol ledgerera
   . Consensus.ShelleyCompatible protocol ledgerera
  => Consensus.Point (Consensus.ShelleyBlock protocol ledgerera)
  -> ChainPoint
fromConsensusPoint :: forall protocol ledgerera.
ShelleyCompatible protocol ledgerera =>
Point (ShelleyBlock protocol ledgerera) -> ChainPoint
fromConsensusPoint Point (ShelleyBlock protocol ledgerera)
Consensus.GenesisPoint = ChainPoint
ChainPointAtGenesis
fromConsensusPoint (Consensus.BlockPoint SlotNo
slot HeaderHash (ShelleyBlock protocol ledgerera)
h) =
  SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash (Proxy (ShelleyBlock protocol ledgerera)
-> HeaderHash (ShelleyBlock protocol ledgerera) -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy (ShelleyBlock protocol ledgerera)
-> HeaderHash (ShelleyBlock protocol ledgerera) -> ShortByteString
Consensus.toShortRawHash Proxy (ShelleyBlock protocol ledgerera)
proxy HeaderHash (ShelleyBlock protocol ledgerera)
h))
 where
  proxy :: Proxy (Consensus.ShelleyBlock protocol ledgerera)
  proxy :: Proxy (ShelleyBlock protocol ledgerera)
proxy = Proxy (ShelleyBlock protocol ledgerera)
forall {k} (t :: k). Proxy t
Proxy

chainPointToSlotNo :: ChainPoint -> Maybe SlotNo
chainPointToSlotNo :: ChainPoint -> Maybe SlotNo
chainPointToSlotNo ChainPoint
ChainPointAtGenesis = Maybe SlotNo
forall a. Maybe a
Nothing
chainPointToSlotNo (ChainPoint SlotNo
slotNo Hash BlockHeader
_) = SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
slotNo

chainPointToHeaderHash :: ChainPoint -> Maybe (Hash BlockHeader)
chainPointToHeaderHash :: ChainPoint -> Maybe (Hash BlockHeader)
chainPointToHeaderHash ChainPoint
ChainPointAtGenesis = Maybe (Hash BlockHeader)
forall a. Maybe a
Nothing
chainPointToHeaderHash (ChainPoint SlotNo
_ Hash BlockHeader
blockHeader) = Hash BlockHeader -> Maybe (Hash BlockHeader)
forall a. a -> Maybe a
Just Hash BlockHeader
blockHeader

-- ----------------------------------------------------------------------------
-- Chain tips
--

-- | This is like a 'ChainPoint' but is conventionally used for the tip of the
-- chain: that is the most recent block at the end of the chain.
--
-- It also carries the 'BlockNo' of the chain tip.
data ChainTip
  = ChainTipAtGenesis
  | ChainTip !SlotNo !(Hash BlockHeader) !BlockNo
  deriving (ChainTip -> ChainTip -> Bool
(ChainTip -> ChainTip -> Bool)
-> (ChainTip -> ChainTip -> Bool) -> Eq ChainTip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainTip -> ChainTip -> Bool
== :: ChainTip -> ChainTip -> Bool
$c/= :: ChainTip -> ChainTip -> Bool
/= :: ChainTip -> ChainTip -> Bool
Eq, Int -> ChainTip -> ShowS
[ChainTip] -> ShowS
ChainTip -> String
(Int -> ChainTip -> ShowS)
-> (ChainTip -> String) -> ([ChainTip] -> ShowS) -> Show ChainTip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainTip -> ShowS
showsPrec :: Int -> ChainTip -> ShowS
$cshow :: ChainTip -> String
show :: ChainTip -> String
$cshowList :: [ChainTip] -> ShowS
showList :: [ChainTip] -> ShowS
Show)

instance ToJSON ChainTip where
  toJSON :: ChainTip -> Value
toJSON ChainTip
ChainTipAtGenesis = Value
Aeson.Null
  toJSON (ChainTip SlotNo
slot Hash BlockHeader
headerHash (Consensus.BlockNo Word64
bNum)) =
    [Pair] -> Value
object
      [ Key
"slot" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
      , Key
"hash" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
headerHash
      , Key
"block" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
bNum
      ]

chainTipToChainPoint :: ChainTip -> ChainPoint
chainTipToChainPoint :: ChainTip -> ChainPoint
chainTipToChainPoint ChainTip
ChainTipAtGenesis = ChainPoint
ChainPointAtGenesis
chainTipToChainPoint (ChainTip SlotNo
s Hash BlockHeader
h BlockNo
_) = SlotNo -> Hash BlockHeader -> ChainPoint
ChainPoint SlotNo
s Hash BlockHeader
h

makeChainTip :: WithOrigin BlockNo -> ChainPoint -> ChainTip
makeChainTip :: WithOrigin BlockNo -> ChainPoint -> ChainTip
makeChainTip WithOrigin BlockNo
woBlockNo ChainPoint
chainPoint = case WithOrigin BlockNo
woBlockNo of
  WithOrigin BlockNo
Origin -> ChainTip
ChainTipAtGenesis
  At BlockNo
blockNo -> case ChainPoint
chainPoint of
    ChainPoint
ChainPointAtGenesis -> ChainTip
ChainTipAtGenesis
    ChainPoint SlotNo
slotNo Hash BlockHeader
headerHash -> SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slotNo Hash BlockHeader
headerHash BlockNo
blockNo

fromConsensusTip
  :: ()
  => Consensus.CardanoBlock L.StandardCrypto ~ block
  => Consensus.Tip block
  -> ChainTip
fromConsensusTip :: forall block.
(CardanoBlock StandardCrypto ~ block) =>
Tip block -> ChainTip
fromConsensusTip = Tip block -> ChainTip
Tip (CardanoBlock StandardCrypto) -> ChainTip
conv
 where
  conv
    :: Consensus.Tip (Consensus.CardanoBlock Consensus.StandardCrypto)
    -> ChainTip
  conv :: Tip (CardanoBlock StandardCrypto) -> ChainTip
conv Tip (CardanoBlock StandardCrypto)
Consensus.TipGenesis = ChainTip
ChainTipAtGenesis
  conv (Consensus.Tip SlotNo
slot (Consensus.OneEraHash ShortByteString
h) BlockNo
block) =
    SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
h) BlockNo
block