{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Instances requires for consensus/ledger integration
module Ouroboros.Consensus.Byron.Ledger.Ledger (
    ByronTransition (..)
    -- * Ledger integration
  , byronEraParams
  , byronEraParamsNeverHardForks
  , initByronLedgerState
    -- * Serialisation
  , decodeByronAnnTip
  , decodeByronLedgerState
  , decodeByronQuery
  , decodeByronResult
  , encodeByronAnnTip
  , encodeByronExtLedgerState
  , encodeByronHeaderState
  , encodeByronLedgerState
  , encodeByronQuery
  , encodeByronResult
    -- * Type family instances
  , BlockQuery (..)
  , LedgerState (..)
  , LedgerTables (..)
  , Ticked (..)
    -- * Auxiliary
  , validationErrorImpossible
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Byron.API as CC
import qualified Cardano.Chain.Common as Gen
import qualified Cardano.Chain.Genesis as Gen
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Chain.Update.Validation.Endorsement as UPE
import qualified Cardano.Chain.Update.Validation.Interface as UPI
import qualified Cardano.Chain.UTxO as CC
import qualified Cardano.Chain.ValidationMode as CC
import           Cardano.Ledger.BaseTypes (unNonZero)
import           Cardano.Ledger.Binary (fromByronCBOR, toByronCBOR)
import           Cardano.Ledger.Binary.Plain (encodeListLen, enforceSize)
import           Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import           Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (decode, encode)
import           Control.Monad (replicateM)
import           Control.Monad.Except (Except, runExcept, throwError)
import qualified Control.State.Transition.Extended as STS
import           Data.ByteString (ByteString)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Void (Void)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger.Block
import           Ouroboros.Consensus.Byron.Ledger.Conversions
import           Ouroboros.Consensus.Byron.Ledger.HeaderValidation ()
import           Ouroboros.Consensus.Byron.Ledger.PBFT
import           Ouroboros.Consensus.Byron.Ledger.Serialisation
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Forecast
import           Ouroboros.Consensus.HardFork.Abstract
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.CommonProtocolParams
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsPeerSelection
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Storage.LedgerDB
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.IndexedMemPack

{-------------------------------------------------------------------------------
  LedgerState
-------------------------------------------------------------------------------}

data instance LedgerState ByronBlock mk = ByronLedgerState {
      forall (mk :: MapKind).
LedgerState ByronBlock mk -> WithOrigin BlockNo
byronLedgerTipBlockNo :: !(WithOrigin BlockNo)
    , forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState      :: !CC.ChainValidationState
    , forall (mk :: MapKind).
LedgerState ByronBlock mk -> ByronTransition
byronLedgerTransition :: !ByronTransition
    }
  deriving (LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
(LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool)
-> (LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool)
-> Eq (LedgerState ByronBlock mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
$c== :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
== :: LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
$c/= :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
/= :: LedgerState ByronBlock mk -> LedgerState ByronBlock mk -> Bool
Eq, Int -> LedgerState ByronBlock mk -> ShowS
[LedgerState ByronBlock mk] -> ShowS
LedgerState ByronBlock mk -> String
(Int -> LedgerState ByronBlock mk -> ShowS)
-> (LedgerState ByronBlock mk -> String)
-> ([LedgerState ByronBlock mk] -> ShowS)
-> Show (LedgerState ByronBlock mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind). Int -> LedgerState ByronBlock mk -> ShowS
forall (mk :: MapKind). [LedgerState ByronBlock mk] -> ShowS
forall (mk :: MapKind). LedgerState ByronBlock mk -> String
$cshowsPrec :: forall (mk :: MapKind). Int -> LedgerState ByronBlock mk -> ShowS
showsPrec :: Int -> LedgerState ByronBlock mk -> ShowS
$cshow :: forall (mk :: MapKind). LedgerState ByronBlock mk -> String
show :: LedgerState ByronBlock mk -> String
$cshowList :: forall (mk :: MapKind). [LedgerState ByronBlock mk] -> ShowS
showList :: [LedgerState ByronBlock mk] -> ShowS
Show, (forall x.
 LedgerState ByronBlock mk -> Rep (LedgerState ByronBlock mk) x)
-> (forall x.
    Rep (LedgerState ByronBlock mk) x -> LedgerState ByronBlock mk)
-> Generic (LedgerState ByronBlock mk)
forall x.
Rep (LedgerState ByronBlock mk) x -> LedgerState ByronBlock mk
forall x.
LedgerState ByronBlock mk -> Rep (LedgerState ByronBlock mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (LedgerState ByronBlock mk) x -> LedgerState ByronBlock mk
forall (mk :: MapKind) x.
LedgerState ByronBlock mk -> Rep (LedgerState ByronBlock mk) x
$cfrom :: forall (mk :: MapKind) x.
LedgerState ByronBlock mk -> Rep (LedgerState ByronBlock mk) x
from :: forall x.
LedgerState ByronBlock mk -> Rep (LedgerState ByronBlock mk) x
$cto :: forall (mk :: MapKind) x.
Rep (LedgerState ByronBlock mk) x -> LedgerState ByronBlock mk
to :: forall x.
Rep (LedgerState ByronBlock mk) x -> LedgerState ByronBlock mk
Generic, Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
Proxy (LedgerState ByronBlock mk) -> String
(Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState ByronBlock mk) -> String)
-> NoThunks (LedgerState ByronBlock mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind). Proxy (LedgerState ByronBlock mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState ByronBlock mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind). Proxy (LedgerState ByronBlock mk) -> String
showTypeOf :: Proxy (LedgerState ByronBlock mk) -> String
NoThunks)

-- | Information required to determine the transition from Byron to Shelley
data ByronTransition =
    -- | Per candidate proposal, the 'BlockNo' in which it became a candidate
    --
    -- The HFC needs to know when a candidate proposal becomes stable. We cannot
    -- reliably do this using 'SlotNo': doing so would mean that if we were to
    -- switch to a denser fork, something that was previously deemed stable is
    -- suddenly not deemed stable anymore (although in actuality it still is).
    -- We therefore must do this based on 'BlockNo' instead, but unfortunately
    -- the Byron ledger does not record this information. Therefore, we record
    -- it here instead.
    --
    -- Invariant: the domain of this map should equal the set of candidate
    -- proposals.
    ByronTransitionInfo !(Map Update.ProtocolVersion BlockNo)
  deriving (ByronTransition -> ByronTransition -> Bool
(ByronTransition -> ByronTransition -> Bool)
-> (ByronTransition -> ByronTransition -> Bool)
-> Eq ByronTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronTransition -> ByronTransition -> Bool
== :: ByronTransition -> ByronTransition -> Bool
$c/= :: ByronTransition -> ByronTransition -> Bool
/= :: ByronTransition -> ByronTransition -> Bool
Eq, Int -> ByronTransition -> ShowS
[ByronTransition] -> ShowS
ByronTransition -> String
(Int -> ByronTransition -> ShowS)
-> (ByronTransition -> String)
-> ([ByronTransition] -> ShowS)
-> Show ByronTransition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronTransition -> ShowS
showsPrec :: Int -> ByronTransition -> ShowS
$cshow :: ByronTransition -> String
show :: ByronTransition -> String
$cshowList :: [ByronTransition] -> ShowS
showList :: [ByronTransition] -> ShowS
Show, (forall x. ByronTransition -> Rep ByronTransition x)
-> (forall x. Rep ByronTransition x -> ByronTransition)
-> Generic ByronTransition
forall x. Rep ByronTransition x -> ByronTransition
forall x. ByronTransition -> Rep ByronTransition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByronTransition -> Rep ByronTransition x
from :: forall x. ByronTransition -> Rep ByronTransition x
$cto :: forall x. Rep ByronTransition x -> ByronTransition
to :: forall x. Rep ByronTransition x -> ByronTransition
Generic, Context -> ByronTransition -> IO (Maybe ThunkInfo)
Proxy ByronTransition -> String
(Context -> ByronTransition -> IO (Maybe ThunkInfo))
-> (Context -> ByronTransition -> IO (Maybe ThunkInfo))
-> (Proxy ByronTransition -> String)
-> NoThunks ByronTransition
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ByronTransition -> IO (Maybe ThunkInfo)
noThunks :: Context -> ByronTransition -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ByronTransition -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ByronTransition -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ByronTransition -> String
showTypeOf :: Proxy ByronTransition -> String
NoThunks)

instance UpdateLedger ByronBlock

type instance LedgerCfg (LedgerState ByronBlock) = Gen.Config

initByronLedgerState :: Gen.Config
                     -> Maybe CC.UTxO -- ^ Optionally override UTxO
                     -> LedgerState ByronBlock mk
initByronLedgerState :: forall (mk :: MapKind).
Config -> Maybe UTxO -> LedgerState ByronBlock mk
initByronLedgerState Config
genesis Maybe UTxO
mUtxo = ByronLedgerState {
      byronLedgerState :: ChainValidationState
byronLedgerState      = Maybe UTxO -> ChainValidationState -> ChainValidationState
override Maybe UTxO
mUtxo ChainValidationState
initState
    , byronLedgerTipBlockNo :: WithOrigin BlockNo
byronLedgerTipBlockNo = WithOrigin BlockNo
forall t. WithOrigin t
Origin
    , byronLedgerTransition :: ByronTransition
byronLedgerTransition = Map ProtocolVersion BlockNo -> ByronTransition
ByronTransitionInfo Map ProtocolVersion BlockNo
forall k a. Map k a
Map.empty
    }
  where
    initState :: CC.ChainValidationState
    initState :: ChainValidationState
initState = case Except Error ChainValidationState
-> Either Error ChainValidationState
forall e a. Except e a -> Either e a
runExcept (Except Error ChainValidationState
 -> Either Error ChainValidationState)
-> Except Error ChainValidationState
-> Either Error ChainValidationState
forall a b. (a -> b) -> a -> b
$ Config -> Except Error ChainValidationState
forall (m :: * -> *).
MonadError Error m =>
Config -> m ChainValidationState
CC.initialChainValidationState Config
genesis of
      Right ChainValidationState
st -> ChainValidationState
st
      Left Error
e   -> String -> ChainValidationState
forall a. HasCallStack => String -> a
error (String -> ChainValidationState) -> String -> ChainValidationState
forall a b. (a -> b) -> a -> b
$
        String
"could not create initial ChainValidationState: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Error -> String
forall a. Show a => a -> String
show Error
e

    override :: Maybe CC.UTxO
             -> CC.ChainValidationState -> CC.ChainValidationState
    override :: Maybe UTxO -> ChainValidationState -> ChainValidationState
override Maybe UTxO
Nothing     ChainValidationState
st = ChainValidationState
st
    override (Just UTxO
utxo) ChainValidationState
st = ChainValidationState
st { CC.cvsUtxo = utxo }

{-------------------------------------------------------------------------------
  GetTip
-------------------------------------------------------------------------------}

instance GetTip (LedgerState ByronBlock) where
  getTip :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> Point (LedgerState ByronBlock)
getTip = Point ByronBlock -> Point (LedgerState ByronBlock)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point ByronBlock -> Point (LedgerState ByronBlock))
-> (LedgerState ByronBlock mk -> Point ByronBlock)
-> LedgerState ByronBlock mk
-> Point (LedgerState ByronBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> Point ByronBlock
getByronTip (ChainValidationState -> Point ByronBlock)
-> (LedgerState ByronBlock mk -> ChainValidationState)
-> LedgerState ByronBlock mk
-> Point ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState

instance GetTip (Ticked (LedgerState ByronBlock)) where
  getTip :: forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk
-> Point (Ticked (LedgerState ByronBlock))
getTip = Point ByronBlock -> Point (Ticked (LedgerState ByronBlock))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point ByronBlock -> Point (Ticked (LedgerState ByronBlock)))
-> (Ticked (LedgerState ByronBlock) mk -> Point ByronBlock)
-> Ticked (LedgerState ByronBlock) mk
-> Point (Ticked (LedgerState ByronBlock))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> Point ByronBlock
getByronTip (ChainValidationState -> Point ByronBlock)
-> (Ticked (LedgerState ByronBlock) mk -> ChainValidationState)
-> Ticked (LedgerState ByronBlock) mk
-> Point ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState ByronBlock) mk -> ChainValidationState
forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
tickedByronLedgerState

getByronTip :: CC.ChainValidationState -> Point ByronBlock
getByronTip :: ChainValidationState -> Point ByronBlock
getByronTip ChainValidationState
state =
    case ChainValidationState -> Either GenesisHash HeaderHash
CC.cvsPreviousHash ChainValidationState
state of
      -- In this case there are no blocks in the ledger state. The genesis
      -- block does not occupy a slot, so its point is Origin.
      Left GenesisHash
_genHash -> Point ByronBlock
forall {k} (block :: k). Point block
GenesisPoint
      Right HeaderHash
hdrHash -> SlotNo -> HeaderHash ByronBlock -> Point ByronBlock
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
slot (HeaderHash -> ByronHash
ByronHash HeaderHash
hdrHash)
        where
          slot :: SlotNo
slot = SlotNumber -> SlotNo
fromByronSlotNo (ChainValidationState -> SlotNumber
CC.cvsLastSlot ChainValidationState
state)

{-------------------------------------------------------------------------------
  Ticked ledger state
-------------------------------------------------------------------------------}

-- | The ticked Byron ledger state
data instance Ticked (LedgerState ByronBlock) mk = TickedByronLedgerState {
      forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
tickedByronLedgerState        :: !CC.ChainValidationState
    , forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ByronTransition
untickedByronLedgerTransition :: !ByronTransition
    }
  deriving ((forall x.
 Ticked (LedgerState ByronBlock) mk
 -> Rep (Ticked (LedgerState ByronBlock) mk) x)
-> (forall x.
    Rep (Ticked (LedgerState ByronBlock) mk) x
    -> Ticked (LedgerState ByronBlock) mk)
-> Generic (Ticked (LedgerState ByronBlock) mk)
forall x.
Rep (Ticked (LedgerState ByronBlock) mk) x
-> Ticked (LedgerState ByronBlock) mk
forall x.
Ticked (LedgerState ByronBlock) mk
-> Rep (Ticked (LedgerState ByronBlock) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (Ticked (LedgerState ByronBlock) mk) x
-> Ticked (LedgerState ByronBlock) mk
forall (mk :: MapKind) x.
Ticked (LedgerState ByronBlock) mk
-> Rep (Ticked (LedgerState ByronBlock) mk) x
$cfrom :: forall (mk :: MapKind) x.
Ticked (LedgerState ByronBlock) mk
-> Rep (Ticked (LedgerState ByronBlock) mk) x
from :: forall x.
Ticked (LedgerState ByronBlock) mk
-> Rep (Ticked (LedgerState ByronBlock) mk) x
$cto :: forall (mk :: MapKind) x.
Rep (Ticked (LedgerState ByronBlock) mk) x
-> Ticked (LedgerState ByronBlock) mk
to :: forall x.
Rep (Ticked (LedgerState ByronBlock) mk) x
-> Ticked (LedgerState ByronBlock) mk
Generic, Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState ByronBlock) mk) -> String
(Context
 -> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState ByronBlock) mk) -> String)
-> NoThunks (Ticked (LedgerState ByronBlock) mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (Ticked (LedgerState ByronBlock) mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Ticked (LedgerState ByronBlock) mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (Ticked (LedgerState ByronBlock) mk) -> String
showTypeOf :: Proxy (Ticked (LedgerState ByronBlock) mk) -> String
NoThunks)

instance IsLedger (LedgerState ByronBlock) where
  type LedgerErr (LedgerState ByronBlock) = CC.ChainValidationError

  type AuxLedgerEvent (LedgerState ByronBlock) =
    VoidLedgerEvent (LedgerState ByronBlock)

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> SlotNo
-> LedgerState ByronBlock EmptyMK
-> LedgerResult
     (LedgerState ByronBlock) (Ticked (LedgerState ByronBlock) DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
_ LedgerCfg (LedgerState ByronBlock)
cfg SlotNo
slotNo ByronLedgerState{ChainValidationState
WithOrigin BlockNo
ByronTransition
byronLedgerTipBlockNo :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> WithOrigin BlockNo
byronLedgerState :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerTransition :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> ByronTransition
byronLedgerTipBlockNo :: WithOrigin BlockNo
byronLedgerState :: ChainValidationState
byronLedgerTransition :: ByronTransition
..} = Ticked (LedgerState ByronBlock) DiffMK
-> LedgerResult
     (LedgerState ByronBlock) (Ticked (LedgerState ByronBlock) DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult (Ticked (LedgerState ByronBlock) DiffMK
 -> LedgerResult
      (LedgerState ByronBlock) (Ticked (LedgerState ByronBlock) DiffMK))
-> Ticked (LedgerState ByronBlock) DiffMK
-> LedgerResult
     (LedgerState ByronBlock) (Ticked (LedgerState ByronBlock) DiffMK)
forall a b. (a -> b) -> a -> b
$
      TickedByronLedgerState {
          tickedByronLedgerState :: ChainValidationState
tickedByronLedgerState =
            Config
-> SlotNumber -> ChainValidationState -> ChainValidationState
CC.applyChainTick Config
LedgerCfg (LedgerState ByronBlock)
cfg (SlotNo -> SlotNumber
toByronSlotNo SlotNo
slotNo) ChainValidationState
byronLedgerState
        , untickedByronLedgerTransition :: ByronTransition
untickedByronLedgerTransition =
            ByronTransition
byronLedgerTransition
        }

type instance TxIn  (LedgerState ByronBlock) = Void
type instance TxOut (LedgerState ByronBlock) = Void

instance LedgerTablesAreTrivial (LedgerState ByronBlock) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState ByronBlock mk -> LedgerState ByronBlock mk'
convertMapKind (ByronLedgerState WithOrigin BlockNo
x ChainValidationState
y ByronTransition
z) = WithOrigin BlockNo
-> ChainValidationState
-> ByronTransition
-> LedgerState ByronBlock mk'
forall (mk :: MapKind).
WithOrigin BlockNo
-> ChainValidationState
-> ByronTransition
-> LedgerState ByronBlock mk
ByronLedgerState WithOrigin BlockNo
x ChainValidationState
y ByronTransition
z
instance LedgerTablesAreTrivial (Ticked (LedgerState ByronBlock)) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked (LedgerState ByronBlock) mk
-> Ticked (LedgerState ByronBlock) mk'
convertMapKind (TickedByronLedgerState ChainValidationState
x ByronTransition
y) = ChainValidationState
-> ByronTransition -> Ticked (LedgerState ByronBlock) mk'
forall (mk :: MapKind).
ChainValidationState
-> ByronTransition -> Ticked (LedgerState ByronBlock) mk
TickedByronLedgerState ChainValidationState
x ByronTransition
y

deriving via Void
    instance IndexedMemPack (LedgerState ByronBlock EmptyMK) Void

deriving via TrivialLedgerTables (LedgerState ByronBlock)
    instance HasLedgerTables (LedgerState ByronBlock)
deriving via TrivialLedgerTables (Ticked (LedgerState ByronBlock))
    instance HasLedgerTables (Ticked (LedgerState ByronBlock))
deriving via TrivialLedgerTables (LedgerState ByronBlock)
    instance CanStowLedgerTables (LedgerState ByronBlock)
deriving via TrivialLedgerTables (LedgerState ByronBlock)
    instance SerializeTablesWithHint (LedgerState ByronBlock)

{-------------------------------------------------------------------------------
  Supporting the various consensus interfaces
-------------------------------------------------------------------------------}

instance ApplyBlock (LedgerState ByronBlock) ByronBlock where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronBlock))
     (LedgerResult
        (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidation ComputeLedgerEvents
opts =
    (LedgerState ByronBlock DiffMK
 -> LedgerResult
      (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
-> ExceptT
     ChainValidationError Identity (LedgerState ByronBlock DiffMK)
-> ExceptT
     ChainValidationError
     Identity
     (LedgerResult
        (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
forall a b.
(a -> b)
-> ExceptT ChainValidationError Identity a
-> ExceptT ChainValidationError Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerState ByronBlock DiffMK
-> LedgerResult
     (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult (ExceptT
   ChainValidationError Identity (LedgerState ByronBlock DiffMK)
 -> ExceptT
      ChainValidationError
      Identity
      (LedgerResult
         (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)))
-> (Config
    -> ByronBlock
    -> Ticked (LedgerState ByronBlock) ValuesMK
    -> ExceptT
         ChainValidationError Identity (LedgerState ByronBlock DiffMK))
-> Config
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> ExceptT
     ChainValidationError
     Identity
     (LedgerResult
        (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronBlock))
     (LedgerState ByronBlock DiffMK)
forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyByronBlock ValidationPolicy
doValidation ComputeLedgerEvents
opts
  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronBlock))
     (LedgerResult
        (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronBlock))
     (LedgerResult
        (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
defaultApplyBlockLedgerResult
  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> LedgerResult
     (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)
reapplyBlockLedgerResult = (LedgerErr (LedgerState ByronBlock)
 -> LedgerResult
      (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> Ticked (LedgerState ByronBlock) ValuesMK
-> LedgerResult
     (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l -> LedgerResult l (l DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> LedgerResult l (l DiffMK)
defaultReapplyBlockLedgerResult ChainValidationError
-> LedgerResult
     (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)
LedgerErr (LedgerState ByronBlock)
-> LedgerResult
     (LedgerState ByronBlock) (LedgerState ByronBlock DiffMK)
forall err a. err -> a
validationErrorImpossible

  getBlockKeySets :: ByronBlock -> LedgerTables (LedgerState ByronBlock) KeysMK
getBlockKeySets ByronBlock
_ = LedgerTables (LedgerState ByronBlock) KeysMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables

data instance BlockQuery ByronBlock fp result where
  GetUpdateInterfaceState :: BlockQuery ByronBlock QFNoTables UPI.State

instance BlockSupportsLedgerQuery ByronBlock where
  answerPureBlockQuery :: forall result.
ExtLedgerCfg ByronBlock
-> BlockQuery ByronBlock 'QFNoTables result
-> ExtLedgerState ByronBlock EmptyMK
-> result
answerPureBlockQuery ExtLedgerCfg ByronBlock
_cfg BlockQuery ByronBlock 'QFNoTables result
R:BlockQueryByronBlockfpresult 'QFNoTables result
GetUpdateInterfaceState ExtLedgerState ByronBlock EmptyMK
dlv =
      ChainValidationState -> State
CC.cvsUpdateState (LedgerState ByronBlock EmptyMK -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState LedgerState ByronBlock EmptyMK
ledgerState)
    where
      ExtLedgerState { LedgerState ByronBlock EmptyMK
ledgerState :: LedgerState ByronBlock EmptyMK
ledgerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState } = ExtLedgerState ByronBlock EmptyMK
dlv
  answerBlockQueryLookup :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg ByronBlock
-> BlockQuery ByronBlock 'QFLookupTables result
-> ReadOnlyForker' m ByronBlock
-> m result
answerBlockQueryLookup ExtLedgerCfg ByronBlock
_cfg BlockQuery ByronBlock 'QFLookupTables result
q ReadOnlyForker' m ByronBlock
_dlv = case BlockQuery ByronBlock 'QFLookupTables result
q of {}
  answerBlockQueryTraverse :: forall (m :: * -> *) result.
MonadSTM m =>
ExtLedgerCfg ByronBlock
-> BlockQuery ByronBlock 'QFTraverseTables result
-> ReadOnlyForker' m ByronBlock
-> m result
answerBlockQueryTraverse ExtLedgerCfg ByronBlock
_cfg BlockQuery ByronBlock 'QFTraverseTables result
q ReadOnlyForker' m ByronBlock
_dlv = case BlockQuery ByronBlock 'QFTraverseTables result
q of {}
  blockQueryIsSupportedOnVersion :: forall (fp :: QueryFootprint) result.
BlockQuery ByronBlock fp result
-> BlockNodeToClientVersion ByronBlock -> Bool
blockQueryIsSupportedOnVersion BlockQuery ByronBlock fp result
R:BlockQueryByronBlockfpresult fp result
GetUpdateInterfaceState = Bool -> BlockNodeToClientVersion ByronBlock -> Bool
forall a b. a -> b -> a
const Bool
True

instance SameDepIndex2 (BlockQuery ByronBlock) where
  sameDepIndex2 :: forall (x :: QueryFootprint) a (y :: QueryFootprint) b.
BlockQuery ByronBlock x a
-> BlockQuery ByronBlock y b -> Maybe ('(x, a) :~: '(y, b))
sameDepIndex2 BlockQuery ByronBlock x a
R:BlockQueryByronBlockfpresult x a
GetUpdateInterfaceState BlockQuery ByronBlock y b
R:BlockQueryByronBlockfpresult y b
GetUpdateInterfaceState = ('(x, a) :~: '(y, b)) -> Maybe ('(x, a) :~: '(y, b))
forall a. a -> Maybe a
Just '(x, a) :~: '(x, a)
'(x, a) :~: '(y, b)
forall {k} (a :: k). a :~: a
Refl

deriving instance Eq (BlockQuery ByronBlock fp result)
deriving instance Show (BlockQuery ByronBlock fp result)

instance ShowQuery (BlockQuery ByronBlock fp) where
  showResult :: forall result. BlockQuery ByronBlock fp result -> result -> String
showResult BlockQuery ByronBlock fp result
R:BlockQueryByronBlockfpresult fp result
GetUpdateInterfaceState = result -> String
forall a. Show a => a -> String
show

instance ShowProxy (BlockQuery ByronBlock) where

instance LedgerSupportsPeerSelection ByronBlock where
  getPeers :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = [(PoolStake, NonEmpty StakePoolRelay)]
-> LedgerState ByronBlock mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall a b. a -> b -> a
const []

instance CommonProtocolParams ByronBlock where
  maxHeaderSize :: forall (mk :: MapKind). LedgerState ByronBlock mk -> Word32
maxHeaderSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState ByronBlock mk -> Natural)
-> LedgerState ByronBlock mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Natural
Update.ppMaxHeaderSize (ProtocolParameters -> Natural)
-> (LedgerState ByronBlock mk -> ProtocolParameters)
-> LedgerState ByronBlock mk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock mk -> ProtocolParameters
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ProtocolParameters
getProtocolParameters
  maxTxSize :: forall (mk :: MapKind). LedgerState ByronBlock mk -> Word32
maxTxSize     = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState ByronBlock mk -> Natural)
-> LedgerState ByronBlock mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Natural
Update.ppMaxTxSize     (ProtocolParameters -> Natural)
-> (LedgerState ByronBlock mk -> ProtocolParameters)
-> LedgerState ByronBlock mk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock mk -> ProtocolParameters
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ProtocolParameters
getProtocolParameters

-- | Return the protocol parameters adopted by the given ledger.
getProtocolParameters :: LedgerState ByronBlock mk -> Update.ProtocolParameters
getProtocolParameters :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> ProtocolParameters
getProtocolParameters =
      State -> ProtocolParameters
CC.adoptedProtocolParameters
    (State -> ProtocolParameters)
-> (LedgerState ByronBlock mk -> State)
-> LedgerState ByronBlock mk
-> ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> State
CC.cvsUpdateState
    (ChainValidationState -> State)
-> (LedgerState ByronBlock mk -> ChainValidationState)
-> LedgerState ByronBlock mk
-> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerState

instance LedgerSupportsProtocol ByronBlock where
  protocolLedgerView :: forall (mk :: MapKind).
LedgerCfg (LedgerState ByronBlock)
-> Ticked (LedgerState ByronBlock) mk
-> LedgerView (BlockProtocol ByronBlock)
protocolLedgerView LedgerCfg (LedgerState ByronBlock)
_cfg =
        Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView
      (Map -> PBftLedgerView PBftByronCrypto)
-> (Ticked (LedgerState ByronBlock) mk -> Map)
-> Ticked (LedgerState ByronBlock) mk
-> PBftLedgerView PBftByronCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainValidationState -> Map
CC.getDelegationMap
      (ChainValidationState -> Map)
-> (Ticked (LedgerState ByronBlock) mk -> ChainValidationState)
-> Ticked (LedgerState ByronBlock) mk
-> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState ByronBlock) mk -> ChainValidationState
forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
tickedByronLedgerState

  -- Create a forecast of the delegation state
  --
  -- We can return forecasts for slots in the @[NOW .. NOW+2k)@ window, where
  -- @NOW@ is the slot number of the last block applied to the ledger.
  --
  -- These forecasts will be used to validate future headers, i.e., to check
  -- whether they have been created by the right delegates.
  --
  -- We cannot look more than @2k@ slots ahead, because there might be
  -- delegation state changes present in the blocks between the last block
  -- applied to the ledger and the header to validate that can kick in after
  -- @2k@ slots.
  --
  -- To create a forecast, take the delegation state from the given ledger
  -- state, and apply the updates that should be applied by the given slot.
  ledgerViewForecastAt :: forall (mk :: MapKind).
HasCallStack =>
LedgerCfg (LedgerState ByronBlock)
-> LedgerState ByronBlock mk
-> Forecast (LedgerView (BlockProtocol ByronBlock))
ledgerViewForecastAt LedgerCfg (LedgerState ByronBlock)
cfg (ByronLedgerState WithOrigin BlockNo
_tipBlkNo ChainValidationState
st ByronTransition
_) = WithOrigin SlotNo
-> (SlotNo
    -> Except
         OutsideForecastRange (LedgerView (BlockProtocol ByronBlock)))
-> Forecast (LedgerView (BlockProtocol ByronBlock))
forall a.
WithOrigin SlotNo
-> (SlotNo -> Except OutsideForecastRange a) -> Forecast a
Forecast WithOrigin SlotNo
at ((SlotNo
  -> Except
       OutsideForecastRange (LedgerView (BlockProtocol ByronBlock)))
 -> Forecast (LedgerView (BlockProtocol ByronBlock)))
-> (SlotNo
    -> Except
         OutsideForecastRange (LedgerView (BlockProtocol ByronBlock)))
-> Forecast (LedgerView (BlockProtocol ByronBlock))
forall a b. (a -> b) -> a -> b
$ \SlotNo
for ->
      Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView (Map -> PBftLedgerView PBftByronCrypto)
-> ExceptT OutsideForecastRange Identity Map
-> ExceptT
     OutsideForecastRange Identity (PBftLedgerView PBftByronCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if
        | SlotNo
for SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNo
lastSlot ->
          Map -> ExceptT OutsideForecastRange Identity Map
forall a. a -> ExceptT OutsideForecastRange Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map -> ExceptT OutsideForecastRange Identity Map)
-> Map -> ExceptT OutsideForecastRange Identity Map
forall a b. (a -> b) -> a -> b
$ ChainValidationState -> Map
CC.getDelegationMap ChainValidationState
st
        | SlotNo
for SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
maxFor ->
          Map -> ExceptT OutsideForecastRange Identity Map
forall a. a -> ExceptT OutsideForecastRange Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map -> ExceptT OutsideForecastRange Identity Map)
-> Map -> ExceptT OutsideForecastRange Identity Map
forall a b. (a -> b) -> a -> b
$ SlotNumber -> ChainValidationState -> Map
CC.previewDelegationMap (SlotNo -> SlotNumber
toByronSlotNo SlotNo
for) ChainValidationState
st
        | Bool
otherwise ->
          OutsideForecastRange -> ExceptT OutsideForecastRange Identity Map
forall a.
OutsideForecastRange -> ExceptT OutsideForecastRange Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (OutsideForecastRange -> ExceptT OutsideForecastRange Identity Map)
-> OutsideForecastRange
-> ExceptT OutsideForecastRange Identity Map
forall a b. (a -> b) -> a -> b
$ OutsideForecastRange {
              outsideForecastAt :: WithOrigin SlotNo
outsideForecastAt     = WithOrigin SlotNo
at
            , outsideForecastMaxFor :: SlotNo
outsideForecastMaxFor = SlotNo
maxFor
            , outsideForecastFor :: SlotNo
outsideForecastFor    = SlotNo
for
            }
    where
      k :: Word64
k = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SecurityParam -> NonZero Word64
maxRollbacks (SecurityParam -> NonZero Word64)
-> SecurityParam -> NonZero Word64
forall a b. (a -> b) -> a -> b
$ Config -> SecurityParam
genesisSecurityParam Config
LedgerCfg (LedgerState ByronBlock)
cfg
      lastSlot :: SlotNo
lastSlot        = SlotNumber -> SlotNo
fromByronSlotNo (SlotNumber -> SlotNo) -> SlotNumber -> SlotNo
forall a b. (a -> b) -> a -> b
$ ChainValidationState -> SlotNumber
CC.cvsLastSlot ChainValidationState
st
      at :: WithOrigin SlotNo
at              = SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
lastSlot

      -- The upper bound is exclusive
      maxFor :: SlotNo
      maxFor :: SlotNo
maxFor = case WithOrigin SlotNo
at of
          WithOrigin SlotNo
Origin      -> Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k
          NotOrigin SlotNo
s -> Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k)

-- | To be used for a Byron-to-X (where X is typically Shelley) chain.
byronEraParams :: Gen.Config -> HardFork.EraParams
byronEraParams :: Config -> EraParams
byronEraParams Config
genesis = HardFork.EraParams {
      eraEpochSize :: EpochSize
eraEpochSize  = EpochSlots -> EpochSize
fromByronEpochSlots (EpochSlots -> EpochSize) -> EpochSlots -> EpochSize
forall a b. (a -> b) -> a -> b
$ Config -> EpochSlots
Gen.configEpochSlots Config
genesis
    , eraSlotLength :: SlotLength
eraSlotLength = Natural -> SlotLength
fromByronSlotLength (Natural -> SlotLength) -> Natural -> SlotLength
forall a b. (a -> b) -> a -> b
$ Config -> Natural
genesisSlotLength Config
genesis
    , eraSafeZone :: SafeZone
eraSafeZone   = Word64 -> SafeZone
HardFork.StandardSafeZone (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k)
    , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
k)
    }
  where
    k :: Word64
k = NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ SecurityParam -> NonZero Word64
maxRollbacks (SecurityParam -> NonZero Word64)
-> SecurityParam -> NonZero Word64
forall a b. (a -> b) -> a -> b
$ Config -> SecurityParam
genesisSecurityParam Config
genesis

-- | Separate variant of 'byronEraParams' to be used for a Byron-only chain.
byronEraParamsNeverHardForks :: Gen.Config -> HardFork.EraParams
byronEraParamsNeverHardForks :: Config -> EraParams
byronEraParamsNeverHardForks Config
genesis = HardFork.EraParams {
      eraEpochSize :: EpochSize
eraEpochSize  = EpochSlots -> EpochSize
fromByronEpochSlots (EpochSlots -> EpochSize) -> EpochSlots -> EpochSize
forall a b. (a -> b) -> a -> b
$ Config -> EpochSlots
Gen.configEpochSlots Config
genesis
    , eraSlotLength :: SlotLength
eraSlotLength = Natural -> SlotLength
fromByronSlotLength (Natural -> SlotLength) -> Natural -> SlotLength
forall a b. (a -> b) -> a -> b
$ Config -> Natural
genesisSlotLength Config
genesis
    , eraSafeZone :: SafeZone
eraSafeZone   = SafeZone
HardFork.UnsafeIndefiniteSafeZone
    , eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* BlockCount -> Word64
Gen.unBlockCount (Config -> BlockCount
Gen.configK Config
genesis))
    }

instance HasHardForkHistory ByronBlock where
  type HardForkIndices ByronBlock = '[ByronBlock]
  hardForkSummary :: forall (mk :: MapKind).
LedgerCfg (LedgerState ByronBlock)
-> LedgerState ByronBlock mk
-> Summary (HardForkIndices ByronBlock)
hardForkSummary = (LedgerCfg (LedgerState ByronBlock) -> EraParams)
-> LedgerCfg (LedgerState ByronBlock)
-> LedgerState ByronBlock mk
-> Summary '[ByronBlock]
forall blk (mk :: MapKind).
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk mk -> Summary '[blk]
neverForksHardForkSummary Config -> EraParams
LedgerCfg (LedgerState ByronBlock) -> EraParams
byronEraParamsNeverHardForks

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

-- | Mark computation as validation error free
--
-- Given a 'BlockValidationMode' of 'NoBlockValidation', a call to
-- 'applyByronBlock' shouldn't fail since the ledger layer won't be performing
-- any block validation checks. However, because 'applyByronBlock' can fail in
-- the event it is given a 'BlockValidationMode' of 'BlockValidation', it still
-- /looks/ like it can fail (since its type doesn't change based on the
-- 'ValidationMode') and we must still treat it as such.
validationErrorImpossible :: forall err a. err -> a
validationErrorImpossible :: forall err a. err -> a
validationErrorImpossible err
_ = String -> a
forall a. HasCallStack => String -> a
error String
"validationErrorImpossible: unexpected error"

{-------------------------------------------------------------------------------
  Applying a block

  Most of the work here is done by the ledger layer. We just need to pass
  the right arguments, and maintain the snapshots.
-------------------------------------------------------------------------------}

applyByronBlock :: STS.ValidationPolicy
                -> ComputeLedgerEvents
                -> LedgerConfig ByronBlock
                -> ByronBlock
                -> TickedLedgerState ByronBlock mk1
                -> Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
applyByronBlock :: forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronBlock)
-> ByronBlock
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyByronBlock ValidationPolicy
doValidation
                ComputeLedgerEvents
_doEvents
                LedgerCfg (LedgerState ByronBlock)
cfg
                blk :: ByronBlock
blk@(ByronBlock ABlockOrBoundary ByteString
raw SlotNo
_ (ByronHash HeaderHash
blkHash))
                TickedLedgerState ByronBlock mk1
ls =
    case ABlockOrBoundary ByteString
raw of
      CC.ABOBBlock    ABlock ByteString
raw' -> ValidationMode
-> Config
-> ABlock ByteString
-> HeaderHash
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationMode
-> Config
-> ABlock ByteString
-> HeaderHash
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyABlock ValidationMode
byronOpts Config
LedgerCfg (LedgerState ByronBlock)
cfg ABlock ByteString
raw' HeaderHash
blkHash BlockNo
blkNo TickedLedgerState ByronBlock mk1
ls
      CC.ABOBBoundary ABoundaryBlock ByteString
raw' -> Config
-> ABoundaryBlock ByteString
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
forall (mk1 :: MapKind) (mk2 :: MapKind).
Config
-> ABoundaryBlock ByteString
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyABoundaryBlock   Config
LedgerCfg (LedgerState ByronBlock)
cfg ABoundaryBlock ByteString
raw'         BlockNo
blkNo TickedLedgerState ByronBlock mk1
ls
  where
    blkNo :: BlockNo
    blkNo :: BlockNo
blkNo = ByronBlock -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo ByronBlock
blk

    byronOpts :: ValidationMode
byronOpts =
      BlockValidationMode -> ValidationMode
CC.fromBlockValidationMode (BlockValidationMode -> ValidationMode)
-> BlockValidationMode -> ValidationMode
forall a b. (a -> b) -> a -> b
$ case ValidationPolicy
doValidation of
        ValidationPolicy
STS.ValidateAll        -> BlockValidationMode
CC.BlockValidation
        ValidationPolicy
STS.ValidateNone       -> BlockValidationMode
CC.NoBlockValidation
        STS.ValidateSuchThat Context -> Bool
_ -> BlockValidationMode
CC.BlockValidation

applyABlock :: CC.ValidationMode
            -> Gen.Config
            -> CC.ABlock ByteString
            -> CC.HeaderHash
            -> BlockNo
            -> TickedLedgerState ByronBlock mk1
            -> Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
applyABlock :: forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationMode
-> Config
-> ABlock ByteString
-> HeaderHash
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyABlock ValidationMode
validationMode Config
cfg ABlock ByteString
blk HeaderHash
blkHash BlockNo
blkNo TickedByronLedgerState{ChainValidationState
ByronTransition
tickedByronLedgerState :: forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
untickedByronLedgerTransition :: forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ByronTransition
tickedByronLedgerState :: ChainValidationState
untickedByronLedgerTransition :: ByronTransition
..} = do
    st' <- Config
-> ValidationMode
-> ABlock ByteString
-> HeaderHash
-> ChainValidationState
-> ExceptT ChainValidationError Identity ChainValidationState
forall (m :: * -> *).
MonadError ChainValidationError m =>
Config
-> ValidationMode
-> ABlock ByteString
-> HeaderHash
-> ChainValidationState
-> m ChainValidationState
CC.validateBlock Config
cfg ValidationMode
validationMode ABlock ByteString
blk HeaderHash
blkHash ChainValidationState
tickedByronLedgerState

    let updState :: UPI.State
        updState = ChainValidationState -> State
CC.cvsUpdateState ChainValidationState
st'

        -- Transition info as it would look like if all entries were new
        ifNew :: Map Update.ProtocolVersion BlockNo
        ifNew = [(ProtocolVersion, BlockNo)] -> Map ProtocolVersion BlockNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ProtocolVersion, BlockNo)] -> Map ProtocolVersion BlockNo)
-> [(ProtocolVersion, BlockNo)] -> Map ProtocolVersion BlockNo
forall a b. (a -> b) -> a -> b
$ (CandidateProtocolUpdate -> (ProtocolVersion, BlockNo))
-> [CandidateProtocolUpdate] -> [(ProtocolVersion, BlockNo)]
forall a b. (a -> b) -> [a] -> [b]
map CandidateProtocolUpdate -> (ProtocolVersion, BlockNo)
aux (State -> [CandidateProtocolUpdate]
UPI.candidateProtocolUpdates State
updState)
          where
            aux :: UPE.CandidateProtocolUpdate
                -> (Update.ProtocolVersion, BlockNo)
            aux :: CandidateProtocolUpdate -> (ProtocolVersion, BlockNo)
aux CandidateProtocolUpdate
candidate = (CandidateProtocolUpdate -> ProtocolVersion
UPE.cpuProtocolVersion CandidateProtocolUpdate
candidate, BlockNo
blkNo)

        transition' :: ByronTransition
        transition' =
            case ByronTransition
untickedByronLedgerTransition of
              ByronTransitionInfo Map ProtocolVersion BlockNo
oldEntries -> Map ProtocolVersion BlockNo -> ByronTransition
ByronTransitionInfo (Map ProtocolVersion BlockNo -> ByronTransition)
-> Map ProtocolVersion BlockNo -> ByronTransition
forall a b. (a -> b) -> a -> b
$
                -- Candidates that have /just/ become candidates
                let newEntries :: Map Update.ProtocolVersion BlockNo
                    newEntries :: Map ProtocolVersion BlockNo
newEntries = Map ProtocolVersion BlockNo
ifNew Map ProtocolVersion BlockNo
-> Map ProtocolVersion BlockNo -> Map ProtocolVersion BlockNo
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map ProtocolVersion BlockNo
oldEntries

                -- Remove any entries that aren't candidates anymore
                in (Map ProtocolVersion BlockNo
oldEntries Map ProtocolVersion BlockNo
-> Map ProtocolVersion BlockNo -> Map ProtocolVersion BlockNo
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map ProtocolVersion BlockNo
ifNew) Map ProtocolVersion BlockNo
-> Map ProtocolVersion BlockNo -> Map ProtocolVersion BlockNo
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map ProtocolVersion BlockNo
newEntries

    return ByronLedgerState {
          byronLedgerTipBlockNo = NotOrigin blkNo
        , byronLedgerState      = st'
        , byronLedgerTransition = transition'
        }

-- | Apply boundary block
--
-- Since boundary blocks don't modify the delegation state, they also don't
-- modify the delegation history.
applyABoundaryBlock :: Gen.Config
                    -> CC.ABoundaryBlock ByteString
                    -> BlockNo
                    -> TickedLedgerState ByronBlock mk1
                    -> Except (LedgerError ByronBlock) (LedgerState ByronBlock mk2)
applyABoundaryBlock :: forall (mk1 :: MapKind) (mk2 :: MapKind).
Config
-> ABoundaryBlock ByteString
-> BlockNo
-> TickedLedgerState ByronBlock mk1
-> Except
     (LedgerErr (LedgerState ByronBlock)) (LedgerState ByronBlock mk2)
applyABoundaryBlock Config
cfg ABoundaryBlock ByteString
blk BlockNo
blkNo TickedByronLedgerState{ChainValidationState
ByronTransition
tickedByronLedgerState :: forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
untickedByronLedgerTransition :: forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ByronTransition
tickedByronLedgerState :: ChainValidationState
untickedByronLedgerTransition :: ByronTransition
..} = do
    st' <- Config
-> ABoundaryBlock ByteString
-> ChainValidationState
-> ExceptT ChainValidationError Identity ChainValidationState
forall (m :: * -> *).
MonadError ChainValidationError m =>
Config
-> ABoundaryBlock ByteString
-> ChainValidationState
-> m ChainValidationState
CC.validateBoundary Config
cfg ABoundaryBlock ByteString
blk ChainValidationState
tickedByronLedgerState
    return ByronLedgerState {
        byronLedgerTipBlockNo = NotOrigin blkNo
      , byronLedgerState      = st'
      , byronLedgerTransition = untickedByronLedgerTransition
      }

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

encodeByronAnnTip :: AnnTip ByronBlock -> Encoding
encodeByronAnnTip :: AnnTip ByronBlock -> Encoding
encodeByronAnnTip = (HeaderHash ByronBlock -> Encoding)
-> AnnTip ByronBlock -> Encoding
forall blk.
(TipInfo blk ~ TipInfoIsEBB blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
encodeAnnTipIsEBB HeaderHash ByronBlock -> Encoding
encodeByronHeaderHash

decodeByronAnnTip :: Decoder s (AnnTip ByronBlock)
decodeByronAnnTip :: forall s. Decoder s (AnnTip ByronBlock)
decodeByronAnnTip = (forall s. Decoder s (HeaderHash ByronBlock))
-> forall s. Decoder s (AnnTip ByronBlock)
forall blk.
(TipInfo blk ~ TipInfoIsEBB blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
decodeAnnTipIsEBB Decoder s (HeaderHash ByronBlock)
forall s. Decoder s (HeaderHash ByronBlock)
decodeByronHeaderHash

encodeByronExtLedgerState :: ExtLedgerState ByronBlock mk -> Encoding
encodeByronExtLedgerState :: forall (mk :: MapKind). ExtLedgerState ByronBlock mk -> Encoding
encodeByronExtLedgerState = (LedgerState ByronBlock mk -> Encoding)
-> (ChainDepState (BlockProtocol ByronBlock) -> Encoding)
-> (AnnTip ByronBlock -> Encoding)
-> ExtLedgerState ByronBlock mk
-> Encoding
forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk mk
-> Encoding
encodeExtLedgerState
    LedgerState ByronBlock mk -> Encoding
forall (mk :: MapKind). LedgerState ByronBlock mk -> Encoding
encodeByronLedgerState
    ChainDepState (BlockProtocol ByronBlock) -> Encoding
encodeByronChainDepState
    AnnTip ByronBlock -> Encoding
encodeByronAnnTip

encodeByronHeaderState :: HeaderState ByronBlock -> Encoding
encodeByronHeaderState :: HeaderState ByronBlock -> Encoding
encodeByronHeaderState = (ChainDepState (BlockProtocol ByronBlock) -> Encoding)
-> (AnnTip ByronBlock -> Encoding)
-> HeaderState ByronBlock
-> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
    ChainDepState (BlockProtocol ByronBlock) -> Encoding
encodeByronChainDepState
    AnnTip ByronBlock -> Encoding
encodeByronAnnTip

-- | Encode transition info
--
-- We encode the absence of any info separately. This gives us a bit more
-- wiggle room to change our mind about what we store in snapshots, as they
-- typically don't contain any transition info.
--
-- Implementation note: we should have encoded the absence of data with the
-- inclusion of a list length. We didn't, so the decoder is a bit awkward :/
--
-- TODO: If we break compatibility anyway, we might decide to clean this up.
encodeByronTransition :: ByronTransition -> Encoding
encodeByronTransition :: ByronTransition -> Encoding
encodeByronTransition (ByronTransitionInfo Map ProtocolVersion BlockNo
bNos)
  | Map ProtocolVersion BlockNo -> Bool
forall k a. Map k a -> Bool
Map.null Map ProtocolVersion BlockNo
bNos = Word8 -> Encoding
CBOR.encodeWord8 Word8
0
  | Bool
otherwise     =
         Word -> Encoding
CBOR.encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map ProtocolVersion BlockNo -> Int
forall k a. Map k a -> Int
Map.size Map ProtocolVersion BlockNo
bNos))
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat (((ProtocolVersion, BlockNo) -> Encoding)
-> [(ProtocolVersion, BlockNo)] -> [Encoding]
forall a b. (a -> b) -> [a] -> [b]
map (ProtocolVersion, BlockNo) -> Encoding
aux (Map ProtocolVersion BlockNo -> [(ProtocolVersion, BlockNo)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map ProtocolVersion BlockNo
bNos))
  where
    aux :: (Update.ProtocolVersion, BlockNo) -> Encoding
    aux :: (ProtocolVersion, BlockNo) -> Encoding
aux (Update.ProtocolVersion { Word16
pvMajor :: Word16
pvMajor :: ProtocolVersion -> Word16
pvMajor, Word16
pvMinor :: Word16
pvMinor :: ProtocolVersion -> Word16
pvMinor, Word8
pvAlt :: Word8
pvAlt :: ProtocolVersion -> Word8
pvAlt }, BlockNo
bno) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
          Word -> Encoding
CBOR.encodeListLen Word
4
        , Word16 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word16
pvMajor
        , Word16 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word16
pvMinor
        , Word8 -> Encoding
forall a. Serialise a => a -> Encoding
encode Word8
pvAlt
        , BlockNo -> Encoding
forall a. Serialise a => a -> Encoding
encode BlockNo
bno
        ]

-- | Decode Byron transition info
--
-- See comments for 'encodeByronTransition'.
decodeByronTransition :: Decoder s ByronTransition
decodeByronTransition :: forall s. Decoder s ByronTransition
decodeByronTransition = do
    ttype <- Decoder s TokenType
forall s. Decoder s TokenType
CBOR.peekTokenType
    fmap ByronTransitionInfo $ case ttype of
      TokenType
CBOR.TypeUInt -> do
        tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
        case tag of
          Word8
0          -> Map ProtocolVersion BlockNo
-> Decoder s (Map ProtocolVersion BlockNo)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ProtocolVersion BlockNo
 -> Decoder s (Map ProtocolVersion BlockNo))
-> Map ProtocolVersion BlockNo
-> Decoder s (Map ProtocolVersion BlockNo)
forall a b. (a -> b) -> a -> b
$ Map ProtocolVersion BlockNo
forall k a. Map k a
Map.empty
          Word8
_otherwise -> String -> Decoder s (Map ProtocolVersion BlockNo)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeByronTransition: unexpected tag"
      TokenType
CBOR.TypeListLen -> do
        size <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
        Map.fromAscList <$> replicateM size aux
      TokenType
_otherwise ->
        String -> Decoder s (Map ProtocolVersion BlockNo)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"decodeByronTransition: unexpected token type"
  where
    aux :: Decoder s (Update.ProtocolVersion, BlockNo)
    aux :: forall s. Decoder s (ProtocolVersion, BlockNo)
aux = do
        Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"decodeByronTransition.aux" Int
4
        pvMajor <- Decoder s Word16
forall s. Decoder s Word16
forall a s. Serialise a => Decoder s a
decode
        pvMinor <- decode
        pvAlt   <- decode
        bno     <- decode
        return (Update.ProtocolVersion { pvMajor, pvMinor, pvAlt }, bno)

encodeByronLedgerState :: LedgerState ByronBlock mk -> Encoding
encodeByronLedgerState :: forall (mk :: MapKind). LedgerState ByronBlock mk -> Encoding
encodeByronLedgerState ByronLedgerState{ChainValidationState
WithOrigin BlockNo
ByronTransition
byronLedgerTipBlockNo :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> WithOrigin BlockNo
byronLedgerState :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> ChainValidationState
byronLedgerTransition :: forall (mk :: MapKind).
LedgerState ByronBlock mk -> ByronTransition
byronLedgerTipBlockNo :: WithOrigin BlockNo
byronLedgerState :: ChainValidationState
byronLedgerTransition :: ByronTransition
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
3
    , WithOrigin BlockNo -> Encoding
forall a. Serialise a => a -> Encoding
encode WithOrigin BlockNo
byronLedgerTipBlockNo
    , ChainValidationState -> Encoding
forall a. Serialise a => a -> Encoding
encode ChainValidationState
byronLedgerState
    , ByronTransition -> Encoding
encodeByronTransition ByronTransition
byronLedgerTransition
    ]

decodeByronLedgerState :: Decoder s (LedgerState ByronBlock mk)
decodeByronLedgerState :: forall s (mk :: MapKind). Decoder s (LedgerState ByronBlock mk)
decodeByronLedgerState = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ByronLedgerState" Int
3
    WithOrigin BlockNo
-> ChainValidationState
-> ByronTransition
-> LedgerState ByronBlock mk
forall (mk :: MapKind).
WithOrigin BlockNo
-> ChainValidationState
-> ByronTransition
-> LedgerState ByronBlock mk
ByronLedgerState
      (WithOrigin BlockNo
 -> ChainValidationState
 -> ByronTransition
 -> LedgerState ByronBlock mk)
-> Decoder s (WithOrigin BlockNo)
-> Decoder
     s
     (ChainValidationState
      -> ByronTransition -> LedgerState ByronBlock mk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (WithOrigin BlockNo)
forall s. Decoder s (WithOrigin BlockNo)
forall a s. Serialise a => Decoder s a
decode
      Decoder
  s
  (ChainValidationState
   -> ByronTransition -> LedgerState ByronBlock mk)
-> Decoder s ChainValidationState
-> Decoder s (ByronTransition -> LedgerState ByronBlock mk)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ChainValidationState
forall s. Decoder s ChainValidationState
forall a s. Serialise a => Decoder s a
decode
      Decoder s (ByronTransition -> LedgerState ByronBlock mk)
-> Decoder s ByronTransition
-> Decoder s (LedgerState ByronBlock mk)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByronTransition
forall s. Decoder s ByronTransition
decodeByronTransition

encodeByronQuery :: BlockQuery ByronBlock fp result -> Encoding
encodeByronQuery :: forall (fp :: QueryFootprint) result.
BlockQuery ByronBlock fp result -> Encoding
encodeByronQuery BlockQuery ByronBlock fp result
query = case BlockQuery ByronBlock fp result
query of
    BlockQuery ByronBlock fp result
R:BlockQueryByronBlockfpresult fp result
GetUpdateInterfaceState -> Word8 -> Encoding
CBOR.encodeWord8 Word8
0

decodeByronQuery :: Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
decodeByronQuery :: forall s. Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
decodeByronQuery = do
    tag <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case tag of
      Word8
0 -> SomeBlockQuery (BlockQuery ByronBlock)
-> Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery ByronBlock)
 -> Decoder s (SomeBlockQuery (BlockQuery ByronBlock)))
-> SomeBlockQuery (BlockQuery ByronBlock)
-> Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
forall a b. (a -> b) -> a -> b
$ BlockQuery ByronBlock 'QFNoTables State
-> SomeBlockQuery (BlockQuery ByronBlock)
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery ByronBlock 'QFNoTables State
GetUpdateInterfaceState
      Word8
_ -> String -> Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (SomeBlockQuery (BlockQuery ByronBlock)))
-> String -> Decoder s (SomeBlockQuery (BlockQuery ByronBlock))
forall a b. (a -> b) -> a -> b
$ String
"decodeByronQuery: invalid tag " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
tag

encodeByronResult :: BlockQuery ByronBlock fp result -> result -> Encoding
encodeByronResult :: forall (fp :: QueryFootprint) result.
BlockQuery ByronBlock fp result -> result -> Encoding
encodeByronResult BlockQuery ByronBlock fp result
query = case BlockQuery ByronBlock fp result
query of
    BlockQuery ByronBlock fp result
R:BlockQueryByronBlockfpresult fp result
GetUpdateInterfaceState -> result -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

decodeByronResult :: BlockQuery ByronBlock fp result
                  -> forall s. Decoder s result
decodeByronResult :: forall (fp :: QueryFootprint) result.
BlockQuery ByronBlock fp result -> forall s. Decoder s result
decodeByronResult BlockQuery ByronBlock fp result
query = case BlockQuery ByronBlock fp result
query of
    BlockQuery ByronBlock fp result
R:BlockQueryByronBlockfpresult fp result
GetUpdateInterfaceState -> Decoder s result
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance CanUpgradeLedgerTables (LedgerState ByronBlock) where
  upgradeTables :: forall (mk1 :: MapKind) (mk2 :: MapKind).
LedgerState ByronBlock mk1
-> LedgerState ByronBlock mk2
-> LedgerTables (LedgerState ByronBlock) ValuesMK
-> LedgerTables (LedgerState ByronBlock) ValuesMK
upgradeTables LedgerState ByronBlock mk1
_ LedgerState ByronBlock mk2
_ = LedgerTables (LedgerState ByronBlock) ValuesMK
-> LedgerTables (LedgerState ByronBlock) ValuesMK
forall a. a -> a
id