{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Byron.ByronHFC
  ( ByronBlockHFC
  , ByronPartialLedgerConfig (..)
  ) where

import Cardano.Binary
import qualified Cardano.Chain.Common as CC
import qualified Cardano.Chain.Genesis as CC.Genesis
import qualified Cardano.Chain.Update as CC.Update
import Control.Monad
import qualified Data.Map.Strict as Map
import Data.Maybe (listToMaybe, mapMaybe)
import Data.MemPack
import Data.SOP.Index (Index (..))
import Data.Void (Void, absurd)
import Data.Word
import GHC.Generics
import NoThunks.Class
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Ledger
import qualified Ouroboros.Consensus.Byron.Ledger.Inspect as Byron.Inspect
import Ouroboros.Consensus.Byron.Node ()
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.Degenerate
import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
import Ouroboros.Consensus.HardFork.Simple
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Ouroboros.Consensus.Node.Serialisation
import Ouroboros.Consensus.Protocol.PBFT (PBft, PBftCrypto)
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.IndexedMemPack

{-------------------------------------------------------------------------------
  Synonym for convenience
-------------------------------------------------------------------------------}

-- | Byron as the single era in the hard fork combinator
type ByronBlockHFC = HardForkBlock '[ByronBlock]

{-------------------------------------------------------------------------------
  NoHardForks instance
-------------------------------------------------------------------------------}

instance ImmutableEraParams ByronBlock where
  immutableEraParams :: TopLevelConfig ByronBlock -> EraParams
immutableEraParams TopLevelConfig ByronBlock
cfg =
    Config -> EraParams
byronEraParamsNeverHardForks (BlockConfig ByronBlock -> Config
byronGenesisConfig (TopLevelConfig ByronBlock -> BlockConfig ByronBlock
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock TopLevelConfig ByronBlock
cfg))

instance NoHardForks ByronBlock where
  toPartialLedgerConfig :: forall (proxy :: * -> *).
proxy ByronBlock
-> LedgerConfig ByronBlock -> PartialLedgerConfig ByronBlock
toPartialLedgerConfig proxy ByronBlock
_ LedgerConfig ByronBlock
cfg =
    ByronPartialLedgerConfig
      { byronLedgerConfig :: LedgerConfig ByronBlock
byronLedgerConfig = LedgerConfig ByronBlock
cfg
      , byronTriggerHardFork :: TriggerHardFork
byronTriggerHardFork = TriggerHardFork
TriggerHardForkNotDuringThisExecution
      }

{-------------------------------------------------------------------------------
  SupportedNetworkProtocolVersion instance
-------------------------------------------------------------------------------}

-- | Forward to the ByronBlock instance. Only supports
-- 'HardForkNodeToNodeDisabled', which is compatible with nodes running with
-- 'ByronBlock'.
instance SupportedNetworkProtocolVersion ByronBlockHFC where
  supportedNodeToNodeVersions :: Proxy ByronBlockHFC
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
supportedNodeToNodeVersions Proxy ByronBlockHFC
_ =
    (BlockNodeToNodeVersion ByronBlock
 -> BlockNodeToNodeVersion ByronBlockHFC)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToNodeVersion ByronBlock
-> BlockNodeToNodeVersion ByronBlockHFC
BlockNodeToNodeVersion ByronBlock
-> HardForkNodeToNodeVersion '[ByronBlock]
forall x (xs1 :: [*]).
BlockNodeToNodeVersion x -> HardForkNodeToNodeVersion (x : xs1)
HardForkNodeToNodeDisabled (Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
 -> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC))
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlockHFC)
forall a b. (a -> b) -> a -> b
$
      Proxy ByronBlock
-> Map NodeToNodeVersion (BlockNodeToNodeVersion ByronBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

  supportedNodeToClientVersions :: Proxy ByronBlockHFC
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
supportedNodeToClientVersions Proxy ByronBlockHFC
_ =
    (BlockNodeToClientVersion ByronBlock
 -> BlockNodeToClientVersion ByronBlockHFC)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map BlockNodeToClientVersion ByronBlock
-> BlockNodeToClientVersion ByronBlockHFC
BlockNodeToClientVersion ByronBlock
-> HardForkNodeToClientVersion '[ByronBlock]
forall x (xs1 :: [*]).
BlockNodeToClientVersion x -> HardForkNodeToClientVersion (x : xs1)
HardForkNodeToClientDisabled (Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
 -> Map
      NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC))
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlockHFC)
forall a b. (a -> b) -> a -> b
$
      Proxy ByronBlock
-> Map NodeToClientVersion (BlockNodeToClientVersion ByronBlock)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronBlock)

  latestReleasedNodeVersion :: Proxy ByronBlockHFC
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion = Proxy ByronBlockHFC
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault

{-------------------------------------------------------------------------------
  SerialiseHFC instance
-------------------------------------------------------------------------------}

instance SerialiseConstraintsHFC ByronBlock

-- | Forward to the ByronBlock instance, this means we don't add an era
-- wrapper around blocks on disk. This makes sure we're compatible with the
-- existing Byron blocks.
instance SerialiseHFC '[ByronBlock] where
  encodeDiskHfcBlock :: CodecConfig ByronBlockHFC -> ByronBlockHFC -> Encoding
encodeDiskHfcBlock (DegenCodecConfig CodecConfig ByronBlock
ccfg) (DegenBlock ByronBlock
b) =
    CodecConfig ByronBlock -> ByronBlock -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfg ByronBlock
b
  decodeDiskHfcBlock :: CodecConfig ByronBlockHFC
-> forall s. Decoder s (ByteString -> ByronBlockHFC)
decodeDiskHfcBlock (DegenCodecConfig CodecConfig ByronBlock
ccfg) =
    (ByronBlock -> ByronBlockHFC)
-> (ByteString -> ByronBlock) -> ByteString -> ByronBlockHFC
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronBlock -> ByronBlockHFC
forall b. NoHardForks b => b -> HardForkBlock '[b]
DegenBlock ((ByteString -> ByronBlock) -> ByteString -> ByronBlockHFC)
-> Decoder s (ByteString -> ByronBlock)
-> Decoder s (ByteString -> ByronBlockHFC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig ByronBlock
-> forall s. Decoder s (ByteString -> ByronBlock)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronBlock
ccfg
  reconstructHfcPrefixLen :: forall (proxy :: * -> *). proxy (Header ByronBlockHFC) -> PrefixLen
reconstructHfcPrefixLen proxy (Header ByronBlockHFC)
_ =
    Proxy (Header ByronBlock) -> PrefixLen
forall (proxy :: * -> *). proxy (Header ByronBlock) -> PrefixLen
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk) -> PrefixLen
reconstructPrefixLen (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header ByronBlock))
  reconstructHfcNestedCtxt :: forall (proxy :: * -> *).
proxy (Header ByronBlockHFC)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
reconstructHfcNestedCtxt proxy (Header ByronBlockHFC)
_ ShortByteString
prefix SizeInBytes
blockSize =
    (forall a.
 NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ ByronBlockHFC Header a)
-> SomeSecond (NestedCtxt Header) ByronBlock
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
forall blk (f :: * -> *) blk' (f' :: * -> *).
(forall a. NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a)
-> SomeSecond (NestedCtxt f) blk -> SomeSecond (NestedCtxt f') blk'
mapSomeNestedCtxt NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlockHFC Header a
forall a.
NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlockHFC Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (SomeSecond (NestedCtxt Header) ByronBlock
 -> SomeSecond (NestedCtxt Header) ByronBlockHFC)
-> SomeSecond (NestedCtxt Header) ByronBlock
-> SomeSecond (NestedCtxt Header) ByronBlockHFC
forall a b. (a -> b) -> a -> b
$
      Proxy (Header ByronBlock)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlock
forall (proxy :: * -> *).
proxy (Header ByronBlock)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) ByronBlock
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk)
-> ShortByteString -> SizeInBytes -> SomeSecond (NestedCtxt f) blk
reconstructNestedCtxt (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header ByronBlock)) ShortByteString
prefix SizeInBytes
blockSize
  getHfcBinaryBlockInfo :: ByronBlockHFC -> BinaryBlockInfo
getHfcBinaryBlockInfo (DegenBlock ByronBlock
b) =
    ByronBlock -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo ByronBlock
b

{-------------------------------------------------------------------------------
  Figure out the transition point for Byron

  The Byron ledger defines the update 'State' in
  "Cardano.Chain.Update.Validation.Interface". The critical piece of state we
  need is

  > candidateProtocolUpdates :: ![CandidateProtocolUpdate]

  which are the update proposals that have been voted on, accepted, and
  endorsed, and now need to become stable. In `tryBumpVersion`
  ("Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump") we
  find the candidates that are at least 'kUpdateStabilityParam' (@== 4k@) deep,
  and then construct

  > State
  > { nextProtocolVersion    = cpuProtocolVersion
  > , nextProtocolParameters = cpuProtocolParameters
  > }

  (with 'State' from "Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump")
  where 'cpuProtocolVersion'/'cpuProtocolParameters' are the version and
  parameters from the update. This then ends up in the following callstack

  > applyChainTick
  > |
  > \-- epochTransition
  >     |
  >     \-- registerEpoch
  >         |
  >         \-- tryBumpVersion

  Now, if this is changing the major version of the protocol, then this actually
  indicates the transition to Shelley, and the Byron 'applyChainTick' won't
  actually happen. Instead, in 'singleEraTransition' we will report the
  'EpochNo' of the transition as soon as it's @2k@ (not @4k@!) deep: in other
  words, as soon as it is stable; at this point, the HFC will do the rest.

  A slightly subtle point is that the Byron ledger does not record any
  information about /past/ updates to the protocol parameters, and so if we
  /were/ to ask the Byron ledger /after/ the update when the transition is
  going to take place (did take place), it will say 'Nothing': transition not
  yet known. In practice this won't matter, as it will have been translated to
  a Shelley ledger at that point.
-------------------------------------------------------------------------------}

byronTransition ::
  PartialLedgerConfig ByronBlock ->
  -- | Shelley major protocol version
  Word16 ->
  LedgerState ByronBlock mk ->
  Maybe EpochNo
byronTransition :: forall (mk :: MapKind).
PartialLedgerConfig ByronBlock
-> Word16 -> LedgerState ByronBlock mk -> Maybe EpochNo
byronTransition PartialLedgerConfig ByronBlock
partialConfig Word16
shelleyMajorVersion LedgerState ByronBlock mk
state =
  [EpochNo] -> Maybe EpochNo
forall a. [a] -> Maybe a
takeAny
    ([EpochNo] -> Maybe EpochNo)
-> (LedgerState ByronBlock mk -> [EpochNo])
-> LedgerState ByronBlock mk
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolUpdate -> Maybe EpochNo) -> [ProtocolUpdate] -> [EpochNo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ProtocolUpdate -> Maybe EpochNo
isTransitionToShelley
    ([ProtocolUpdate] -> [EpochNo])
-> (LedgerState ByronBlock mk -> [ProtocolUpdate])
-> LedgerState ByronBlock mk
-> [EpochNo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerConfig ByronBlock
-> LedgerState ByronBlock mk -> [ProtocolUpdate]
forall (mk :: MapKind).
LedgerConfig ByronBlock
-> LedgerState ByronBlock mk -> [ProtocolUpdate]
Byron.Inspect.protocolUpdates LedgerConfig ByronBlock
lConfig
    (LedgerState ByronBlock mk -> Maybe EpochNo)
-> LedgerState ByronBlock mk -> Maybe EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState ByronBlock mk
state
 where
  ByronPartialLedgerConfig LedgerConfig ByronBlock
lConfig TriggerHardFork
_ = PartialLedgerConfig ByronBlock
partialConfig
  ByronTransitionInfo Map ProtocolVersion BlockNo
transitionInfo = LedgerState ByronBlock mk -> ByronTransition
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ByronTransition
byronLedgerTransition LedgerState ByronBlock mk
state

  k :: BlockCount
k = GenesisData -> BlockCount
CC.Genesis.gdK (GenesisData -> BlockCount) -> GenesisData -> BlockCount
forall a b. (a -> b) -> a -> b
$ Config -> GenesisData
CC.Genesis.configGenesisData Config
LedgerConfig ByronBlock
lConfig

  isTransitionToShelley :: Byron.Inspect.ProtocolUpdate -> Maybe EpochNo
  isTransitionToShelley :: ProtocolUpdate -> Maybe EpochNo
isTransitionToShelley ProtocolUpdate
update = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ProtocolVersion -> Word16
CC.Update.pvMajor ProtocolVersion
version Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
shelleyMajorVersion
    case ProtocolUpdate -> UpdateState
Byron.Inspect.protocolUpdateState ProtocolUpdate
update of
      Byron.Inspect.UpdateCandidate SlotNo
_becameCandidateSlotNo EpochNo
adoptedIn -> do
        becameCandidateBlockNo <- ProtocolVersion -> Map ProtocolVersion BlockNo -> Maybe BlockNo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ProtocolVersion
version Map ProtocolVersion BlockNo
transitionInfo
        guard $ isReallyStable becameCandidateBlockNo
        return adoptedIn
      Byron.Inspect.UpdateStableCandidate EpochNo
adoptedIn ->
        -- If the Byron ledger thinks it's stable, it's _definitely_ stable
        EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return EpochNo
adoptedIn
      UpdateState
_otherwise ->
        -- The proposal isn't yet a candidate, never mind a stable one
        Maybe EpochNo
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
   where
    version :: CC.Update.ProtocolVersion
    version :: ProtocolVersion
version = ProtocolUpdate -> ProtocolVersion
Byron.Inspect.protocolUpdateVersion ProtocolUpdate
update

  -- Normally, stability in the ledger is defined in terms of slots, not
  -- blocks. Byron considers the proposal to be stable after the slot is more
  -- than @2k@ old. That is not wrong: after @2k@, the block indeed is stable.
  --
  -- Unfortunately, this means that the /conclusion about stability itself/
  -- is /not/ stable: if we were to switch to a denser fork, we might change
  -- our mind (on the sparse chain we thought the block was already stable,
  -- but on the dense chain we conclude it is it not yet stable).
  --
  -- It is unclear at the moment if this presents a problem; the HFC assumes
  -- monotonicity of timing info, in the sense that that any slot/time
  -- conversions are either unknown or else not subject to rollback.
  -- The problem sketched above might mean that we can go from "conversion
  -- known" to "conversion unknown", but then when we go back again to
  -- "conversion known", we /are/ guaranteed that we'd get the same answer.
  --
  -- Rather than trying to analyse this subtle problem, we instead base
  -- stability on block numbers; after the block is `k` deep, we know for sure
  -- that it is stable, and moreover, no matter which chain we switch to, that
  -- will remain to be the case.
  --
  -- The Byron 'UpdateState' records the 'SlotNo' of the block in which the
  -- proposal became a candidate (i.e., when the last required endorsement
  -- came in). That doesn't tell us very much, we need to know the block
  -- number; that's precisely what the 'ByronTransition' part of the Byron
  -- state tells us.
  isReallyStable :: BlockNo -> Bool
  isReallyStable :: BlockNo -> Bool
isReallyStable (BlockNo Word64
bno) = Word64
distance Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= BlockCount -> Word64
CC.unBlockCount BlockCount
k
   where
    distance :: Word64
    distance :: Word64
distance = case LedgerState ByronBlock mk -> WithOrigin BlockNo
forall (mk :: MapKind).
LedgerState ByronBlock mk -> WithOrigin BlockNo
byronLedgerTipBlockNo LedgerState ByronBlock mk
state of
      WithOrigin BlockNo
Origin -> Word64
bno Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
      NotOrigin (BlockNo Word64
tip) -> Word64
tip Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bno

  -- We only expect a single proposal that updates to Shelley, but in case
  -- there are multiple, any one will do
  takeAny :: [a] -> Maybe a
  takeAny :: forall a. [a] -> Maybe a
takeAny = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe

{-------------------------------------------------------------------------------
  SingleEraBlock Byron
-------------------------------------------------------------------------------}

instance SingleEraBlock ByronBlock where
  singleEraTransition :: forall (mk :: MapKind).
PartialLedgerConfig ByronBlock
-> EraParams -> Bound -> LedgerState ByronBlock mk -> Maybe EpochNo
singleEraTransition PartialLedgerConfig ByronBlock
pcfg EraParams
_eraParams Bound
_eraStart LedgerState ByronBlock mk
ledgerState =
    case ByronPartialLedgerConfig -> TriggerHardFork
byronTriggerHardFork PartialLedgerConfig ByronBlock
ByronPartialLedgerConfig
pcfg of
      TriggerHardFork
TriggerHardForkNotDuringThisExecution -> Maybe EpochNo
forall a. Maybe a
Nothing
      TriggerHardForkAtEpoch EpochNo
epoch -> EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
epoch
      TriggerHardForkAtVersion Word16
shelleyMajorVersion ->
        PartialLedgerConfig ByronBlock
-> Word16 -> LedgerState ByronBlock mk -> Maybe EpochNo
forall (mk :: MapKind).
PartialLedgerConfig ByronBlock
-> Word16 -> LedgerState ByronBlock mk -> Maybe EpochNo
byronTransition
          PartialLedgerConfig ByronBlock
pcfg
          Word16
shelleyMajorVersion
          LedgerState ByronBlock mk
ledgerState

  singleEraInfo :: forall (proxy :: * -> *).
proxy ByronBlock -> SingleEraInfo ByronBlock
singleEraInfo proxy ByronBlock
_ =
    SingleEraInfo
      { singleEraName :: Text
singleEraName = Text
"Byron"
      }

instance PBftCrypto bc => HasPartialConsensusConfig (PBft bc)

-- Use defaults

-- | When Byron is part of the hard-fork combinator, we use the partial ledger
-- config. Standalone Byron uses the regular ledger config. This means that
-- the partial ledger config is the perfect place to store the trigger
-- condition for the hard fork to Shelley, as we don't have to modify the
-- ledger config for standalone Byron.
data ByronPartialLedgerConfig = ByronPartialLedgerConfig
  { ByronPartialLedgerConfig -> LedgerConfig ByronBlock
byronLedgerConfig :: !(LedgerConfig ByronBlock)
  , ByronPartialLedgerConfig -> TriggerHardFork
byronTriggerHardFork :: !TriggerHardFork
  }
  deriving (Int -> ByronPartialLedgerConfig -> ShowS
[ByronPartialLedgerConfig] -> ShowS
ByronPartialLedgerConfig -> String
(Int -> ByronPartialLedgerConfig -> ShowS)
-> (ByronPartialLedgerConfig -> String)
-> ([ByronPartialLedgerConfig] -> ShowS)
-> Show ByronPartialLedgerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronPartialLedgerConfig -> ShowS
showsPrec :: Int -> ByronPartialLedgerConfig -> ShowS
$cshow :: ByronPartialLedgerConfig -> String
show :: ByronPartialLedgerConfig -> String
$cshowList :: [ByronPartialLedgerConfig] -> ShowS
showList :: [ByronPartialLedgerConfig] -> ShowS
Show, (forall x.
 ByronPartialLedgerConfig -> Rep ByronPartialLedgerConfig x)
-> (forall x.
    Rep ByronPartialLedgerConfig x -> ByronPartialLedgerConfig)
-> Generic ByronPartialLedgerConfig
forall x.
Rep ByronPartialLedgerConfig x -> ByronPartialLedgerConfig
forall x.
ByronPartialLedgerConfig -> Rep ByronPartialLedgerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ByronPartialLedgerConfig -> Rep ByronPartialLedgerConfig x
from :: forall x.
ByronPartialLedgerConfig -> Rep ByronPartialLedgerConfig x
$cto :: forall x.
Rep ByronPartialLedgerConfig x -> ByronPartialLedgerConfig
to :: forall x.
Rep ByronPartialLedgerConfig x -> ByronPartialLedgerConfig
Generic, Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo)
Proxy ByronPartialLedgerConfig -> String
(Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo))
-> (Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo))
-> (Proxy ByronPartialLedgerConfig -> String)
-> NoThunks ByronPartialLedgerConfig
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo)
noThunks :: Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ByronPartialLedgerConfig -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ByronPartialLedgerConfig -> String
showTypeOf :: Proxy ByronPartialLedgerConfig -> String
NoThunks)

instance HasPartialLedgerConfig ByronBlock where
  type PartialLedgerConfig ByronBlock = ByronPartialLedgerConfig

  completeLedgerConfig :: forall (proxy :: * -> *).
proxy ByronBlock
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig ByronBlock
-> LedgerConfig ByronBlock
completeLedgerConfig proxy ByronBlock
_ EpochInfo (Except PastHorizonException)
_ = PartialLedgerConfig ByronBlock -> LedgerConfig ByronBlock
ByronPartialLedgerConfig -> LedgerConfig ByronBlock
byronLedgerConfig

instance SerialiseNodeToClient ByronBlock ByronPartialLedgerConfig where
  encodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> ByronPartialLedgerConfig
-> Encoding
encodeNodeToClient CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
version (ByronPartialLedgerConfig LedgerConfig ByronBlock
lconfig TriggerHardFork
triggerhf) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
2
      , forall a. ToCBOR a => a -> Encoding
toCBOR @(LedgerConfig ByronBlock) LedgerConfig ByronBlock
lconfig
      , CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> TriggerHardFork
-> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
version TriggerHardFork
triggerhf
      ]
  decodeNodeToClient :: CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s ByronPartialLedgerConfig
decodeNodeToClient CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
version = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ByronPartialLedgerConfig" Int
2
    Config -> TriggerHardFork -> ByronPartialLedgerConfig
LedgerConfig ByronBlock
-> TriggerHardFork -> ByronPartialLedgerConfig
ByronPartialLedgerConfig
      (Config -> TriggerHardFork -> ByronPartialLedgerConfig)
-> Decoder s Config
-> Decoder s (TriggerHardFork -> ByronPartialLedgerConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR @(LedgerConfig ByronBlock)
      Decoder s (TriggerHardFork -> ByronPartialLedgerConfig)
-> Decoder s TriggerHardFork -> Decoder s ByronPartialLedgerConfig
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> forall s. Decoder s TriggerHardFork
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
version

{-------------------------------------------------------------------------------
  Canonical TxIn
-------------------------------------------------------------------------------}

instance HasCanonicalTxIn '[ByronBlock] where
  newtype CanonicalTxIn '[ByronBlock] = ByronHFCTxIn
    { CanonicalTxIn '[ByronBlock] -> Void
getByronHFCTxIn :: Void
    }
    deriving stock (Int -> CanonicalTxIn '[ByronBlock] -> ShowS
[CanonicalTxIn '[ByronBlock]] -> ShowS
CanonicalTxIn '[ByronBlock] -> String
(Int -> CanonicalTxIn '[ByronBlock] -> ShowS)
-> (CanonicalTxIn '[ByronBlock] -> String)
-> ([CanonicalTxIn '[ByronBlock]] -> ShowS)
-> Show (CanonicalTxIn '[ByronBlock])
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CanonicalTxIn '[ByronBlock] -> ShowS
showsPrec :: Int -> CanonicalTxIn '[ByronBlock] -> ShowS
$cshow :: CanonicalTxIn '[ByronBlock] -> String
show :: CanonicalTxIn '[ByronBlock] -> String
$cshowList :: [CanonicalTxIn '[ByronBlock]] -> ShowS
showList :: [CanonicalTxIn '[ByronBlock]] -> ShowS
Show, CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
(CanonicalTxIn '[ByronBlock]
 -> CanonicalTxIn '[ByronBlock] -> Bool)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> Bool)
-> Eq (CanonicalTxIn '[ByronBlock])
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
== :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
$c/= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
/= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
Eq, Eq (CanonicalTxIn '[ByronBlock])
Eq (CanonicalTxIn '[ByronBlock]) =>
(CanonicalTxIn '[ByronBlock]
 -> CanonicalTxIn '[ByronBlock] -> Ordering)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> Bool)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> Bool)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> Bool)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> Bool)
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock])
-> (CanonicalTxIn '[ByronBlock]
    -> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock])
-> Ord (CanonicalTxIn '[ByronBlock])
CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> Ordering
CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock]
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 :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> Ordering
compare :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> Ordering
$c< :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
< :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
$c<= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
<= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
$c> :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
> :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
$c>= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
>= :: CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock] -> Bool
$cmax :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock]
max :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock]
$cmin :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock]
min :: CanonicalTxIn '[ByronBlock]
-> CanonicalTxIn '[ByronBlock] -> CanonicalTxIn '[ByronBlock]
Ord)
    deriving newtype (Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo)
Proxy (CanonicalTxIn '[ByronBlock]) -> String
(Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo))
-> (Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo))
-> (Proxy (CanonicalTxIn '[ByronBlock]) -> String)
-> NoThunks (CanonicalTxIn '[ByronBlock])
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo)
noThunks :: Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CanonicalTxIn '[ByronBlock] -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CanonicalTxIn '[ByronBlock]) -> String
showTypeOf :: Proxy (CanonicalTxIn '[ByronBlock]) -> String
NoThunks, String
String
-> (CanonicalTxIn '[ByronBlock] -> Int)
-> (forall s. CanonicalTxIn '[ByronBlock] -> Pack s ())
-> (forall b. Buffer b => Unpack b (CanonicalTxIn '[ByronBlock]))
-> MemPack (CanonicalTxIn '[ByronBlock])
CanonicalTxIn '[ByronBlock] -> Int
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b (CanonicalTxIn '[ByronBlock])
forall s. CanonicalTxIn '[ByronBlock] -> Pack s ()
$ctypeName :: String
typeName :: String
$cpackedByteCount :: CanonicalTxIn '[ByronBlock] -> Int
packedByteCount :: CanonicalTxIn '[ByronBlock] -> Int
$cpackM :: forall s. CanonicalTxIn '[ByronBlock] -> Pack s ()
packM :: forall s. CanonicalTxIn '[ByronBlock] -> Pack s ()
$cunpackM :: forall b. Buffer b => Unpack b (CanonicalTxIn '[ByronBlock])
unpackM :: forall b. Buffer b => Unpack b (CanonicalTxIn '[ByronBlock])
MemPack)

  injectCanonicalTxIn :: forall x.
Index '[ByronBlock] x
-> TxIn (LedgerState x) -> CanonicalTxIn '[ByronBlock]
injectCanonicalTxIn Index '[ByronBlock] x
IZ TxIn (LedgerState x)
key = Void -> CanonicalTxIn '[ByronBlock]
forall a. Void -> a
absurd Void
TxIn (LedgerState x)
key
  injectCanonicalTxIn (IS Index xs' x
idx') TxIn (LedgerState x)
_ = case Index xs' x
idx' of {}

  ejectCanonicalTxIn :: forall x.
Index '[ByronBlock] x
-> CanonicalTxIn '[ByronBlock] -> TxIn (LedgerState x)
ejectCanonicalTxIn Index '[ByronBlock] x
_ CanonicalTxIn '[ByronBlock]
key = Void -> TxIn (LedgerState x)
forall a. Void -> a
absurd (Void -> TxIn (LedgerState x)) -> Void -> TxIn (LedgerState x)
forall a b. (a -> b) -> a -> b
$ CanonicalTxIn '[ByronBlock] -> Void
getByronHFCTxIn CanonicalTxIn '[ByronBlock]
key

instance HasHardForkTxOut '[ByronBlock] where
  type HardForkTxOut '[ByronBlock] = Void
  injectHardForkTxOut :: forall x.
Index '[ByronBlock] x
-> TxOut (LedgerState x) -> HardForkTxOut '[ByronBlock]
injectHardForkTxOut Index '[ByronBlock] x
IZ TxOut (LedgerState x)
txout = Void -> Void
forall a. Void -> a
absurd Void
TxOut (LedgerState x)
txout
  injectHardForkTxOut (IS Index xs' x
idx') TxOut (LedgerState x)
_ = case Index xs' x
idx' of {}
  ejectHardForkTxOut :: forall x.
Index '[ByronBlock] x
-> HardForkTxOut '[ByronBlock] -> TxOut (LedgerState x)
ejectHardForkTxOut Index '[ByronBlock] x
IZ HardForkTxOut '[ByronBlock]
txout = Void -> Void
forall a. Void -> a
absurd Void
HardForkTxOut '[ByronBlock]
txout
  ejectHardForkTxOut (IS Index xs' x
idx') HardForkTxOut '[ByronBlock]
_ = case Index xs' x
idx' of {}

deriving via
  Void
  instance
    IndexedMemPack (LedgerState (HardForkBlock '[ByronBlock]) EmptyMK) Void

instance BlockSupportsHFLedgerQuery '[ByronBlock] where
  answerBlockQueryHFLookup :: forall (m :: * -> *) x result.
(All SingleEraBlock '[ByronBlock], Monad m) =>
Index '[ByronBlock] x
-> ExtLedgerCfg x
-> BlockQuery x 'QFLookupTables result
-> ReadOnlyForker' m ByronBlockHFC
-> m result
answerBlockQueryHFLookup Index '[ByronBlock] x
IZ ExtLedgerCfg x
_cfg (BlockQuery ByronBlock 'QFLookupTables result
q :: BlockQuery ByronBlock QFLookupTables result) ReadOnlyForker' m ByronBlockHFC
_dlv = case BlockQuery ByronBlock 'QFLookupTables result
q of {}
  answerBlockQueryHFLookup (IS Index xs' x
is) ExtLedgerCfg x
_cfg BlockQuery x 'QFLookupTables result
_q ReadOnlyForker' m ByronBlockHFC
_dlv = case Index xs' x
is of {}

  answerBlockQueryHFTraverse :: forall (m :: * -> *) x result.
(All SingleEraBlock '[ByronBlock], Monad m) =>
Index '[ByronBlock] x
-> ExtLedgerCfg x
-> BlockQuery x 'QFTraverseTables result
-> ReadOnlyForker' m ByronBlockHFC
-> m result
answerBlockQueryHFTraverse Index '[ByronBlock] x
IZ ExtLedgerCfg x
_cfg (BlockQuery ByronBlock 'QFTraverseTables result
q :: BlockQuery ByronBlock QFTraverseTables result) ReadOnlyForker' m ByronBlockHFC
_dlv = case BlockQuery ByronBlock 'QFTraverseTables result
q of {}
  answerBlockQueryHFTraverse (IS Index xs' x
is) ExtLedgerCfg x
_cfg BlockQuery x 'QFTraverseTables result
_q ReadOnlyForker' m ByronBlockHFC
_dlv = case Index xs' x
is of {}

  queryLedgerGetTraversingFilter :: forall x result.
Index '[ByronBlock] x
-> BlockQuery x 'QFTraverseTables result
-> TxOut (LedgerState ByronBlockHFC)
-> Bool
queryLedgerGetTraversingFilter Index '[ByronBlock] x
IZ (BlockQuery ByronBlock 'QFTraverseTables result
q :: BlockQuery ByronBlock QFTraverseTables result) = case BlockQuery ByronBlock 'QFTraverseTables result
q of {}
  queryLedgerGetTraversingFilter (IS Index xs' x
is) BlockQuery x 'QFTraverseTables result
_q = case Index xs' x
is of {}

deriving via
  TrivialLedgerTables (LedgerState (HardForkBlock '[ByronBlock]))
  instance
    SerializeTablesWithHint (LedgerState (HardForkBlock '[ByronBlock]))