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

-- | Blocks in the blockchain
--
module Cardano.Api.Block (

    -- * Blocks in the context of an era
    Block(.., Block),
    BlockHeader(..),
    getBlockHeader,

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

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

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

    -- * Data family instances
    Hash(..),

    chainPointToHeaderHash,
    chainPointToSlotNo,
    makeChainTip,
  ) where

import           Prelude

import           Data.Aeson (FromJSON (..), ToJSON (..), object, (.=))
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           Cardano.Slotting.Block (BlockNo)
import           Cardano.Slotting.Slot (EpochNo, SlotNo, WithOrigin (..))

import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.Hashing
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.Cardano.ByronHFC as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
import qualified Ouroboros.Consensus.Ledger.SupportsProtocol as Consensus
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
import qualified Ouroboros.Consensus.Shelley.Protocol.Abstract as Consensus
import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus
import qualified Ouroboros.Network.Block as Consensus

import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.UTxO as Byron
import qualified Cardano.Ledger.Block as Ledger
import qualified Cardano.Ledger.Era as Ledger

import           Cardano.Api.Eras
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.KeysShelley
import           Cardano.Api.Modes
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.Tx

{- 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) -> (Void# -> r) -> r
Block header txs <- (getBlockHeaderAndTxs -> (header, txs))

{-# COMPLETE Block #-}

getBlockHeaderAndTxs :: Block era -> (BlockHeader, [Tx era])
getBlockHeaderAndTxs :: 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
        )

getBlockTxs :: forall era . Block era -> [Tx era]
getBlockTxs :: Block era -> [Tx era]
getBlockTxs (ByronBlock Consensus.ByronBlock { ABlockOrBoundary ByteString
byronBlockRaw :: ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw :: ABlockOrBoundary ByteString
Consensus.byronBlockRaw }) =
    case ABlockOrBoundary ByteString
byronBlockRaw of
      Byron.ABOBBoundary{} -> [] -- no txs in EBBs
      Byron.ABOBBlock Byron.ABlock {
          blockBody :: forall a. ABlock a -> ABody a
Byron.blockBody =
            Byron.ABody {
              bodyTxPayload :: forall a. ABody a -> ATxPayload a
Byron.bodyTxPayload = Byron.ATxPayload [ATxAux ByteString]
txs
            }
        } -> (ATxAux ByteString -> Tx ByronEra)
-> [ATxAux ByteString] -> [Tx ByronEra]
forall a b. (a -> b) -> [a] -> [b]
map ATxAux ByteString -> Tx ByronEra
ByronTx [ATxAux ByteString]
txs
getBlockTxs (ShelleyBlock ShelleyBasedEra era
era Consensus.ShelleyBlock{Block
  (ShelleyProtocolHeader (ConsensusProtocol era))
  (ShelleyLedgerEra era)
shelleyBlockRaw :: forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw :: Block
  (ShelleyProtocolHeader (ConsensusProtocol era))
  (ShelleyLedgerEra era)
Consensus.shelleyBlockRaw}) =
    ShelleyBasedEra era
-> (ShelleyCompatible
      (ConsensusProtocol era) (ShelleyLedgerEra era) =>
    [Tx era])
-> [Tx era]
forall era ledgerera a.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era
-> (ShelleyCompatible (ConsensusProtocol era) ledgerera => a) -> a
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
era ((ShelleyCompatible
    (ConsensusProtocol era) (ShelleyLedgerEra era) =>
  [Tx era])
 -> [Tx era])
-> (ShelleyCompatible
      (ConsensusProtocol era) (ShelleyLedgerEra 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
era 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 :: 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxSeq ledgerera -> StrictSeq (Tx ledgerera)
forall era. SupportsSegWit era => TxSeq era -> StrictSeq (Tx era)
Ledger.fromTxSeq TxSeq ledgerera
txs) ]

obtainConsensusShelleyCompatibleEra
  :: forall era ledgerera a.
     ShelleyLedgerEra era ~ ledgerera
  => ShelleyBasedEra era
  -> (Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera => a)
  -> a
obtainConsensusShelleyCompatibleEra :: ShelleyBasedEra era
-> (ShelleyCompatible (ConsensusProtocol era) ledgerera => a) -> a
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
ShelleyBasedEraShelley ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f = a
ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
ShelleyBasedEraAllegra ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f = a
ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
ShelleyBasedEraMary    ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f = a
ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
ShelleyBasedEraAlonzo  ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f = a
ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f
obtainConsensusShelleyCompatibleEra ShelleyBasedEra era
ShelleyBasedEraBabbage ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f = a
ShelleyCompatible (ConsensusProtocol era) ledgerera => a
f

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

-- | A 'Block' in one of the eras supported by a given protocol mode.
--
-- For multi-era modes such as the 'CardanoMode' this type is a sum of the
-- different block types for all the eras. It is used in the ChainSync protocol.
--
data BlockInMode mode where
     BlockInMode :: IsCardanoEra era => Block era -> EraInMode era mode -> BlockInMode mode

deriving instance Show (BlockInMode mode)

fromConsensusBlock :: ConsensusBlockForMode mode ~ block
                   => Consensus.LedgerSupportsProtocol
                        (Consensus.ShelleyBlock
                        (Consensus.TPraos Consensus.StandardCrypto)
                        (Consensus.ShelleyEra Consensus.StandardCrypto))
                   => ConsensusMode mode -> block -> BlockInMode mode
fromConsensusBlock :: ConsensusMode mode -> block -> BlockInMode mode
fromConsensusBlock ConsensusMode mode
ByronMode =
    \block
b -> case block
b of
      Consensus.DegenBlock b' ->
        Block ByronEra
-> EraInMode ByronEra ByronMode -> BlockInMode ByronMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (ByronBlock -> Block ByronEra
ByronBlock ByronBlock
b') EraInMode ByronEra ByronMode
ByronEraInByronMode

fromConsensusBlock ConsensusMode mode
ShelleyMode =
  \block
b -> case block
b of
    Consensus.DegenBlock b' ->
      Block ShelleyEra
-> EraInMode ShelleyEra ShelleyMode -> BlockInMode ShelleyMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                   EraInMode ShelleyEra ShelleyMode
ShelleyEraInShelleyMode

fromConsensusBlock ConsensusMode mode
CardanoMode =
    \block
b -> case block
b of
      Consensus.BlockByron b' ->
        Block ByronEra
-> EraInMode ByronEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (ByronBlock -> Block ByronEra
ByronBlock ByronBlock
b') EraInMode ByronEra CardanoMode
ByronEraInCardanoMode

      Consensus.BlockShelley b' ->
        Block ShelleyEra
-> EraInMode ShelleyEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                     EraInMode ShelleyEra CardanoMode
ShelleyEraInCardanoMode

      Consensus.BlockAllegra b' ->
        Block AllegraEra
-> EraInMode AllegraEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                     EraInMode AllegraEra CardanoMode
AllegraEraInCardanoMode

      Consensus.BlockMary b' ->
        Block MaryEra
-> EraInMode MaryEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                     EraInMode MaryEra CardanoMode
MaryEraInCardanoMode

      Consensus.BlockAlonzo b' ->
        Block AlonzoEra
-> EraInMode AlonzoEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                     EraInMode AlonzoEra CardanoMode
AlonzoEraInCardanoMode

      Consensus.BlockBabbage b' ->
        Block BabbageEra
-> EraInMode BabbageEra CardanoMode -> BlockInMode CardanoMode
forall era mode.
IsCardanoEra era =>
Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode (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')
                     EraInMode BabbageEra CardanoMode
BabbageEraInCardanoMode

toConsensusBlock
  :: ConsensusBlockForMode mode ~ block
  => Consensus.LedgerSupportsProtocol
       (Consensus.ShelleyBlock
       (Consensus.TPraos Consensus.StandardCrypto)
       (Consensus.ShelleyEra Consensus.StandardCrypto))
  => BlockInMode mode -> block
toConsensusBlock :: BlockInMode mode -> block
toConsensusBlock BlockInMode mode
bInMode =
  case BlockInMode mode
bInMode of
    -- Byron mode
    BlockInMode (ByronBlock ByronBlock
b') EraInMode era mode
ByronEraInByronMode -> ByronBlock -> HardForkBlock '[ByronBlock]
forall b. NoHardForks b => b -> HardForkBlock '[b]
Consensus.DegenBlock ByronBlock
b'

    -- Shelley mode
    BlockInMode (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraShelley ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
ShelleyEraInShelleyMode -> ShelleyBlock (TPraos StandardCrypto) StandardShelley
-> HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley]
forall b. NoHardForks b => b -> HardForkBlock '[b]
Consensus.DegenBlock ShelleyBlock (TPraos StandardCrypto) StandardShelley
ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b'

    -- Cardano mode
    BlockInMode (ByronBlock ByronBlock
b') EraInMode era mode
ByronEraInCardanoMode -> ByronBlock -> CardanoBlock StandardCrypto
forall c. ByronBlock -> CardanoBlock c
Consensus.BlockByron ByronBlock
b'
    BlockInMode (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraShelley ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
ShelleyEraInCardanoMode -> 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 (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAllegra ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
AllegraEraInCardanoMode -> 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 (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraMary ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
MaryEraInCardanoMode -> 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 (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraAlonzo ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
AlonzoEraInCardanoMode -> 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 (ShelleyBlock ShelleyBasedEra era
ShelleyBasedEraBabbage ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
b') EraInMode era mode
BabbageEraInCardanoMode -> 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'

-- ----------------------------------------------------------------------------
-- 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
/= :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c/= :: Hash BlockHeader -> Hash BlockHeader -> Bool
== :: Hash BlockHeader -> Hash BlockHeader -> Bool
$c== :: 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
min :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
$cmin :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
max :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
$cmax :: Hash BlockHeader -> Hash BlockHeader -> Hash BlockHeader
>= :: 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
$c< :: Hash BlockHeader -> Hash BlockHeader -> Bool
compare :: Hash BlockHeader -> Hash BlockHeader -> Ordering
$ccompare :: Hash BlockHeader -> Hash BlockHeader -> Ordering
$cp1Ord :: Eq (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
showList :: [Hash BlockHeader] -> ShowS
$cshowList :: [Hash BlockHeader] -> ShowS
show :: Hash BlockHeader -> String
$cshow :: Hash BlockHeader -> String
showsPrec :: Int -> Hash BlockHeader -> ShowS
$cshowsPrec :: Int -> Hash BlockHeader -> ShowS
Show)
  deriving ([Hash BlockHeader] -> Encoding
[Hash BlockHeader] -> Value
Hash BlockHeader -> Encoding
Hash BlockHeader -> Value
(Hash BlockHeader -> Value)
-> (Hash BlockHeader -> Encoding)
-> ([Hash BlockHeader] -> Value)
-> ([Hash BlockHeader] -> Encoding)
-> ToJSON (Hash BlockHeader)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Hash BlockHeader] -> Encoding
$ctoEncodingList :: [Hash BlockHeader] -> Encoding
toJSONList :: [Hash BlockHeader] -> Value
$ctoJSONList :: [Hash BlockHeader] -> Value
toEncoding :: Hash BlockHeader -> Encoding
$ctoEncoding :: Hash BlockHeader -> Encoding
toJSON :: Hash BlockHeader -> Value
$ctoJSON :: Hash BlockHeader -> Value
ToJSON, Value -> Parser [Hash BlockHeader]
Value -> Parser (Hash BlockHeader)
(Value -> Parser (Hash BlockHeader))
-> (Value -> Parser [Hash BlockHeader])
-> FromJSON (Hash BlockHeader)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Hash BlockHeader]
$cparseJSONList :: Value -> Parser [Hash BlockHeader]
parseJSON :: Value -> Parser (Hash BlockHeader)
$cparseJSON :: Value -> Parser (Hash BlockHeader)
FromJSON) via UsingRawBytesHex (Hash BlockHeader)
  deriving String -> Hash BlockHeader
(String -> Hash BlockHeader) -> IsString (Hash BlockHeader)
forall a. (String -> a) -> IsString a
fromString :: String -> Hash BlockHeader
$cfromString :: String -> Hash BlockHeader
IsString via UsingRawBytesHex (Hash BlockHeader)



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

    deserialiseFromRawBytes :: AsType (Hash BlockHeader) -> ByteString -> Maybe (Hash BlockHeader)
deserialiseFromRawBytes (AsHash AsBlockHeader) ByteString
bs
      | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = Hash BlockHeader -> Maybe (Hash BlockHeader)
forall a. a -> Maybe a
Just (Hash BlockHeader -> Maybe (Hash BlockHeader))
-> Hash BlockHeader -> Maybe (Hash BlockHeader)
forall a b. (a -> b) -> a -> b
$! ShortByteString -> Hash BlockHeader
HeaderHash (ByteString -> ShortByteString
SBS.toShort ByteString
bs)
      | Bool
otherwise          = Maybe (Hash BlockHeader)
forall a. Maybe a
Nothing

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 :: Block era -> BlockHeader
getBlockHeader (ShelleyBlock ShelleyBasedEra era
shelleyEra ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era)
block) = case ShelleyBasedEra era
shelleyEra of
  ShelleyBasedEra era
ShelleyBasedEraShelley -> BlockHeader
ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) =>
BlockHeader
go
  ShelleyBasedEra era
ShelleyBasedEraAllegra -> BlockHeader
ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) =>
BlockHeader
go
  ShelleyBasedEra era
ShelleyBasedEraMary -> BlockHeader
ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) =>
BlockHeader
go
  ShelleyBasedEra era
ShelleyBasedEraAlonzo -> BlockHeader
ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) =>
BlockHeader
go
  ShelleyBasedEra era
ShelleyBasedEraBabbage -> BlockHeader
ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) =>
BlockHeader
go
  where
    go :: Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
       => BlockHeader
    go :: BlockHeader
go = SlotNo -> Hash BlockHeader -> BlockNo -> BlockHeader
BlockHeader SlotNo
headerFieldSlot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
hashSBS) BlockNo
headerFieldBlockNo
      where
        Consensus.HeaderFields {
            headerFieldHash :: forall b. HeaderFields b -> HeaderHash b
Consensus.headerFieldHash
              = Consensus.ShelleyHash (Crypto.UnsafeHash hashSBS),
            SlotNo
headerFieldSlot :: forall b. HeaderFields b -> SlotNo
headerFieldSlot :: SlotNo
Consensus.headerFieldSlot,
            BlockNo
headerFieldBlockNo :: forall b. HeaderFields b -> BlockNo
headerFieldBlockNo :: 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
getBlockHeader (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 b. HeaderFields b -> HeaderHash b
Consensus.headerFieldHash = Consensus.ByronHash byronHeaderHash,
      SlotNo
headerFieldSlot :: SlotNo
headerFieldSlot :: forall b. HeaderFields b -> SlotNo
Consensus.headerFieldSlot,
      BlockNo
headerFieldBlockNo :: BlockNo
headerFieldBlockNo :: forall b. HeaderFields b -> 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
/= :: ChainPoint -> ChainPoint -> Bool
$c/= :: ChainPoint -> ChainPoint -> Bool
== :: ChainPoint -> ChainPoint -> Bool
$c== :: 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
showList :: [ChainPoint] -> ShowS
$cshowList :: [ChainPoint] -> ShowS
show :: ChainPoint -> String
$cshow :: ChainPoint -> String
showsPrec :: Int -> ChainPoint -> ShowS
$cshowsPrec :: Int -> ChainPoint -> ShowS
Show)


toConsensusPointInMode :: ConsensusMode mode
                       -> ChainPoint
                       -> Consensus.Point (ConsensusBlockForMode mode)
-- It's the same concrete impl in all cases, but we have to show
-- individually for each case that we satisfy the type equality constraint
-- HeaderHash block ~ OneEraHash xs
toConsensusPointInMode :: ConsensusMode mode
-> ChainPoint -> Point (ConsensusBlockForMode mode)
toConsensusPointInMode ConsensusMode mode
ByronMode   = ChainPoint -> Point (ConsensusBlockForMode mode)
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
ChainPoint -> Point block
toConsensusPointHF
toConsensusPointInMode ConsensusMode mode
ShelleyMode = ChainPoint -> Point (ConsensusBlockForMode mode)
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
ChainPoint -> Point block
toConsensusPointHF
toConsensusPointInMode ConsensusMode mode
CardanoMode = ChainPoint -> Point (ConsensusBlockForMode mode)
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
ChainPoint -> Point block
toConsensusPointHF

fromConsensusPointInMode :: ConsensusMode mode
                         -> Consensus.Point (ConsensusBlockForMode mode)
                         -> ChainPoint
fromConsensusPointInMode :: ConsensusMode mode
-> Point (ConsensusBlockForMode mode) -> ChainPoint
fromConsensusPointInMode ConsensusMode mode
ByronMode   = Point (ConsensusBlockForMode mode) -> ChainPoint
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF
fromConsensusPointInMode ConsensusMode mode
ShelleyMode = Point (ConsensusBlockForMode mode) -> ChainPoint
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF
fromConsensusPointInMode ConsensusMode mode
CardanoMode = Point (ConsensusBlockForMode mode) -> ChainPoint
forall block (xs :: [*]).
(HeaderHash block ~ OneEraHash xs) =>
Point block -> ChainPoint
fromConsensusPointHF


-- | Convert a 'Consensus.Point' for multi-era block type
--
toConsensusPointHF :: Consensus.HeaderHash block ~ Consensus.OneEraHash xs
                   => ChainPoint -> Consensus.Point block
toConsensusPointHF :: ChainPoint -> Point block
toConsensusPointHF  ChainPoint
ChainPointAtGenesis = Point block
forall block. Point block
Consensus.GenesisPoint
toConsensusPointHF (ChainPoint SlotNo
slot (HeaderHash h)) =
    SlotNo -> HeaderHash block -> Point block
forall block. 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 :: Point block -> ChainPoint
fromConsensusPointHF Point block
Consensus.GenesisPoint = ChainPoint
ChainPointAtGenesis
fromConsensusPointHF (Consensus.BlockPoint SlotNo
slot (Consensus.OneEraHash 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 :: ChainPoint -> Point (ShelleyBlock protocol ledgerera)
toConsensusPoint ChainPoint
ChainPointAtGenesis = Point (ShelleyBlock protocol ledgerera)
forall block. Point block
Consensus.GenesisPoint
toConsensusPoint (ChainPoint SlotNo
slot (HeaderHash h)) =
    SlotNo
-> HeaderHash (ShelleyBlock protocol ledgerera)
-> Point (ShelleyBlock protocol ledgerera)
forall block. 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
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 :: 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
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
/= :: ChainTip -> ChainTip -> Bool
$c/= :: ChainTip -> ChainTip -> Bool
== :: ChainTip -> ChainTip -> Bool
$c== :: 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
showList :: [ChainTip] -> ShowS
$cshowList :: [ChainTip] -> ShowS
show :: ChainTip -> String
$cshow :: ChainTip -> String
showsPrec :: Int -> ChainTip -> ShowS
$cshowsPrec :: Int -> 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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
           , Key
"hash" Key -> Text -> Pair
forall kv v. (KeyValue 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 kv v. (KeyValue 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  :: ConsensusBlockForMode mode ~ block
                  => ConsensusMode mode
                  -> Consensus.Tip block
                  -> ChainTip
fromConsensusTip :: ConsensusMode mode -> Tip block -> ChainTip
fromConsensusTip ConsensusMode mode
ByronMode = Tip block -> ChainTip
Tip (HardForkBlock '[ByronBlock]) -> ChainTip
conv
  where
    conv :: Consensus.Tip Consensus.ByronBlockHFC -> ChainTip
    conv :: Tip (HardForkBlock '[ByronBlock]) -> ChainTip
conv Tip (HardForkBlock '[ByronBlock])
Consensus.TipGenesis = ChainTip
ChainTipAtGenesis
    conv (Consensus.Tip SlotNo
slot (Consensus.OneEraHash h) BlockNo
block) =
      SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
h) BlockNo
block

fromConsensusTip ConsensusMode mode
ShelleyMode = Tip block -> ChainTip
Tip
  (HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
-> ChainTip
conv
  where
    conv :: Consensus.Tip (Consensus.ShelleyBlockHFC (Consensus.TPraos Consensus.StandardCrypto) Consensus.StandardShelley)
         -> ChainTip
    conv :: Tip
  (HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
-> ChainTip
conv Tip
  (HardForkBlock
     '[ShelleyBlock (TPraos StandardCrypto) StandardShelley])
Consensus.TipGenesis = ChainTip
ChainTipAtGenesis
    conv (Consensus.Tip SlotNo
slot (Consensus.OneEraHash hashSBS) BlockNo
block) =
      SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
hashSBS) BlockNo
block

fromConsensusTip ConsensusMode mode
CardanoMode = 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 h) BlockNo
block) =
      SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot (ShortByteString -> Hash BlockHeader
HeaderHash ShortByteString
h) BlockNo
block

{-
TODO: In principle we should be able to use this common implementation rather
      than repeating it for each mode above. It does actually type-check. The
      problem is that (at least with ghc-8.10.x) ghc's pattern match warning
      mechanism cannot see that the OneEraHash is a complete pattern match.
      I'm guessing that while the type checker can use the type equality to
      see that OneEraHash is a valid pattern, the exhaustiveness checker is for
      some reason not able to use it to see that it is indeed the only pattern.
fromConsensusTip =
    \mode -> case mode of
      ByronMode   -> conv
      ShelleyMode -> conv
      CardanoMode -> conv
  where
    conv :: HeaderHash block ~ OneEraHash xs
         => Tip block -> ChainTip
    conv TipGenesis                      = ChainTipAtGenesis
    conv (Tip slot (OneEraHash h) block) = ChainTip slot (HeaderHash h) block
-}