{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS -Wno-orphans #-}

module Ouroboros.Consensus.ByronSpec.Ledger.Ledger
  ( ByronSpecLedgerError (..)
  , initByronSpecLedgerState

    -- * Type family instances
  , LedgerState (..)
  , LedgerTables (..)
  , Ticked (..)
  ) where

import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import Codec.Serialise
import Control.Monad.Except
import qualified Control.State.Transition as Spec
import Data.List.NonEmpty (NonEmpty)
import Data.Void (Void)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunk (..), NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.ByronSpec.Ledger.Accessors
import Ouroboros.Consensus.ByronSpec.Ledger.Block
import Ouroboros.Consensus.ByronSpec.Ledger.Conversions
import Ouroboros.Consensus.ByronSpec.Ledger.Genesis (ByronSpecGenesis)
import Ouroboros.Consensus.ByronSpec.Ledger.Orphans ()
import qualified Ouroboros.Consensus.ByronSpec.Ledger.Rules as Rules
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.CommonProtocolParams
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Ticked
import Ouroboros.Consensus.Util.IndexedMemPack

{-------------------------------------------------------------------------------
  State
-------------------------------------------------------------------------------}

data instance LedgerState ByronSpecBlock mk = ByronSpecLedgerState
  { forall (mk :: MapKind).
LedgerState ByronSpecBlock mk -> Maybe SlotNo
byronSpecLedgerTip :: Maybe SlotNo
  -- ^ Tip of the ledger (most recently applied block, if any)
  --
  -- The spec state stores the last applied /hash/, but not the /slot/.
  , forall (mk :: MapKind).
LedgerState ByronSpecBlock mk -> State CHAIN
byronSpecLedgerState :: Spec.State Spec.CHAIN
  -- ^ The spec state proper
  }
  deriving stock (Int -> LedgerState ByronSpecBlock mk -> ShowS
[LedgerState ByronSpecBlock mk] -> ShowS
LedgerState ByronSpecBlock mk -> String
(Int -> LedgerState ByronSpecBlock mk -> ShowS)
-> (LedgerState ByronSpecBlock mk -> String)
-> ([LedgerState ByronSpecBlock mk] -> ShowS)
-> Show (LedgerState ByronSpecBlock mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind).
Int -> LedgerState ByronSpecBlock mk -> ShowS
forall (mk :: MapKind). [LedgerState ByronSpecBlock mk] -> ShowS
forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> String
$cshowsPrec :: forall (mk :: MapKind).
Int -> LedgerState ByronSpecBlock mk -> ShowS
showsPrec :: Int -> LedgerState ByronSpecBlock mk -> ShowS
$cshow :: forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> String
show :: LedgerState ByronSpecBlock mk -> String
$cshowList :: forall (mk :: MapKind). [LedgerState ByronSpecBlock mk] -> ShowS
showList :: [LedgerState ByronSpecBlock mk] -> ShowS
Show, LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
(LedgerState ByronSpecBlock mk
 -> LedgerState ByronSpecBlock mk -> Bool)
-> (LedgerState ByronSpecBlock mk
    -> LedgerState ByronSpecBlock mk -> Bool)
-> Eq (LedgerState ByronSpecBlock mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
$c== :: forall (mk :: MapKind).
LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
== :: LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
$c/= :: forall (mk :: MapKind).
LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
/= :: LedgerState ByronSpecBlock mk
-> LedgerState ByronSpecBlock mk -> Bool
Eq, (forall x.
 LedgerState ByronSpecBlock mk
 -> Rep (LedgerState ByronSpecBlock mk) x)
-> (forall x.
    Rep (LedgerState ByronSpecBlock mk) x
    -> LedgerState ByronSpecBlock mk)
-> Generic (LedgerState ByronSpecBlock mk)
forall x.
Rep (LedgerState ByronSpecBlock mk) x
-> LedgerState ByronSpecBlock mk
forall x.
LedgerState ByronSpecBlock mk
-> Rep (LedgerState ByronSpecBlock mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (LedgerState ByronSpecBlock mk) x
-> LedgerState ByronSpecBlock mk
forall (mk :: MapKind) x.
LedgerState ByronSpecBlock mk
-> Rep (LedgerState ByronSpecBlock mk) x
$cfrom :: forall (mk :: MapKind) x.
LedgerState ByronSpecBlock mk
-> Rep (LedgerState ByronSpecBlock mk) x
from :: forall x.
LedgerState ByronSpecBlock mk
-> Rep (LedgerState ByronSpecBlock mk) x
$cto :: forall (mk :: MapKind) x.
Rep (LedgerState ByronSpecBlock mk) x
-> LedgerState ByronSpecBlock mk
to :: forall x.
Rep (LedgerState ByronSpecBlock mk) x
-> LedgerState ByronSpecBlock mk
Generic)
  deriving anyclass [LedgerState ByronSpecBlock mk] -> Encoding
LedgerState ByronSpecBlock mk -> Encoding
(LedgerState ByronSpecBlock mk -> Encoding)
-> (forall s. Decoder s (LedgerState ByronSpecBlock mk))
-> ([LedgerState ByronSpecBlock mk] -> Encoding)
-> (forall s. Decoder s [LedgerState ByronSpecBlock mk])
-> Serialise (LedgerState ByronSpecBlock mk)
forall s. Decoder s [LedgerState ByronSpecBlock mk]
forall s. Decoder s (LedgerState ByronSpecBlock mk)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall (mk :: MapKind). [LedgerState ByronSpecBlock mk] -> Encoding
forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> Encoding
forall (mk :: MapKind) s. Decoder s [LedgerState ByronSpecBlock mk]
forall (mk :: MapKind) s. Decoder s (LedgerState ByronSpecBlock mk)
$cencode :: forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> Encoding
encode :: LedgerState ByronSpecBlock mk -> Encoding
$cdecode :: forall (mk :: MapKind) s. Decoder s (LedgerState ByronSpecBlock mk)
decode :: forall s. Decoder s (LedgerState ByronSpecBlock mk)
$cencodeList :: forall (mk :: MapKind). [LedgerState ByronSpecBlock mk] -> Encoding
encodeList :: [LedgerState ByronSpecBlock mk] -> Encoding
$cdecodeList :: forall (mk :: MapKind) s. Decoder s [LedgerState ByronSpecBlock mk]
decodeList :: forall s. Decoder s [LedgerState ByronSpecBlock mk]
Serialise
  deriving Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
Proxy (LedgerState ByronSpecBlock mk) -> String
(Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo))
-> (Context
    -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState ByronSpecBlock mk) -> String)
-> NoThunks (LedgerState ByronSpecBlock mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (LedgerState ByronSpecBlock mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (LedgerState ByronSpecBlock mk) -> String
showTypeOf :: Proxy (LedgerState ByronSpecBlock mk) -> String
NoThunks via AllowThunk (LedgerState ByronSpecBlock mk)

newtype ByronSpecLedgerError = ByronSpecLedgerError
  { ByronSpecLedgerError -> NonEmpty (PredicateFailure CHAIN)
unByronSpecLedgerError :: NonEmpty (Spec.PredicateFailure Spec.CHAIN)
  }
  deriving (Int -> ByronSpecLedgerError -> ShowS
[ByronSpecLedgerError] -> ShowS
ByronSpecLedgerError -> String
(Int -> ByronSpecLedgerError -> ShowS)
-> (ByronSpecLedgerError -> String)
-> ([ByronSpecLedgerError] -> ShowS)
-> Show ByronSpecLedgerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronSpecLedgerError -> ShowS
showsPrec :: Int -> ByronSpecLedgerError -> ShowS
$cshow :: ByronSpecLedgerError -> String
show :: ByronSpecLedgerError -> String
$cshowList :: [ByronSpecLedgerError] -> ShowS
showList :: [ByronSpecLedgerError] -> ShowS
Show, ByronSpecLedgerError -> ByronSpecLedgerError -> Bool
(ByronSpecLedgerError -> ByronSpecLedgerError -> Bool)
-> (ByronSpecLedgerError -> ByronSpecLedgerError -> Bool)
-> Eq ByronSpecLedgerError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronSpecLedgerError -> ByronSpecLedgerError -> Bool
== :: ByronSpecLedgerError -> ByronSpecLedgerError -> Bool
$c/= :: ByronSpecLedgerError -> ByronSpecLedgerError -> Bool
/= :: ByronSpecLedgerError -> ByronSpecLedgerError -> Bool
Eq)
  deriving Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo)
Proxy ByronSpecLedgerError -> String
(Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo))
-> (Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo))
-> (Proxy ByronSpecLedgerError -> String)
-> NoThunks ByronSpecLedgerError
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo)
noThunks :: Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ByronSpecLedgerError -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ByronSpecLedgerError -> String
showTypeOf :: Proxy ByronSpecLedgerError -> String
NoThunks via AllowThunk ByronSpecLedgerError

type instance LedgerCfg LedgerState ByronSpecBlock = ByronSpecGenesis

instance UpdateLedger ByronSpecBlock

initByronSpecLedgerState :: ByronSpecGenesis -> LedgerState ByronSpecBlock mk
initByronSpecLedgerState :: forall (mk :: MapKind).
ByronSpecGenesis -> LedgerState ByronSpecBlock mk
initByronSpecLedgerState ByronSpecGenesis
cfg =
  ByronSpecLedgerState
    { byronSpecLedgerTip :: Maybe SlotNo
byronSpecLedgerTip = Maybe SlotNo
forall a. Maybe a
Nothing
    , byronSpecLedgerState :: State CHAIN
byronSpecLedgerState = ByronSpecGenesis -> State CHAIN
Rules.initStateCHAIN ByronSpecGenesis
cfg
    }

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

instance GetTip (LedgerState ByronSpecBlock) where
  getTip :: forall (mk :: MapKind).
LedgerState ByronSpecBlock mk -> Point (LedgerState ByronSpecBlock)
getTip (ByronSpecLedgerState Maybe SlotNo
tip State CHAIN
state) =
    Point ByronSpecBlock -> Point (LedgerState ByronSpecBlock)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point ByronSpecBlock -> Point (LedgerState ByronSpecBlock))
-> Point ByronSpecBlock -> Point (LedgerState ByronSpecBlock)
forall a b. (a -> b) -> a -> b
$
      Maybe SlotNo -> State CHAIN -> Point ByronSpecBlock
getByronSpecTip Maybe SlotNo
tip State CHAIN
state

instance GetTip (Ticked LedgerState ByronSpecBlock) where
  getTip :: forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Point (Ticked LedgerState ByronSpecBlock)
getTip (TickedByronSpecLedgerState Maybe SlotNo
tip State CHAIN
state) =
    Point ByronSpecBlock -> Point (Ticked LedgerState ByronSpecBlock)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point ByronSpecBlock -> Point (Ticked LedgerState ByronSpecBlock))
-> Point ByronSpecBlock
-> Point (Ticked LedgerState ByronSpecBlock)
forall a b. (a -> b) -> a -> b
$
      Maybe SlotNo -> State CHAIN -> Point ByronSpecBlock
getByronSpecTip Maybe SlotNo
tip State CHAIN
state

getByronSpecTip :: Maybe SlotNo -> Spec.State Spec.CHAIN -> Point ByronSpecBlock
getByronSpecTip :: Maybe SlotNo -> State CHAIN -> Point ByronSpecBlock
getByronSpecTip Maybe SlotNo
Nothing State CHAIN
_ = Point ByronSpecBlock
forall {k} (block :: k). Point block
GenesisPoint
getByronSpecTip (Just SlotNo
slot) State CHAIN
state =
  SlotNo -> HeaderHash ByronSpecBlock -> Point ByronSpecBlock
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint
    SlotNo
slot
    (GetChainState Hash
getChainStateHash State CHAIN
state)

{-------------------------------------------------------------------------------
  Ticking
-------------------------------------------------------------------------------}

data instance Ticked LedgerState ByronSpecBlock mk = TickedByronSpecLedgerState
  { forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk -> Maybe SlotNo
untickedByronSpecLedgerTip :: Maybe SlotNo
  , forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk -> State CHAIN
tickedByronSpecLedgerState :: Spec.State Spec.CHAIN
  }
  deriving stock (Int -> Ticked LedgerState ByronSpecBlock mk -> ShowS
[Ticked LedgerState ByronSpecBlock mk] -> ShowS
Ticked LedgerState ByronSpecBlock mk -> String
(Int -> Ticked LedgerState ByronSpecBlock mk -> ShowS)
-> (Ticked LedgerState ByronSpecBlock mk -> String)
-> ([Ticked LedgerState ByronSpecBlock mk] -> ShowS)
-> Show (Ticked LedgerState ByronSpecBlock mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind).
Int -> Ticked LedgerState ByronSpecBlock mk -> ShowS
forall (mk :: MapKind).
[Ticked LedgerState ByronSpecBlock mk] -> ShowS
forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk -> String
$cshowsPrec :: forall (mk :: MapKind).
Int -> Ticked LedgerState ByronSpecBlock mk -> ShowS
showsPrec :: Int -> Ticked LedgerState ByronSpecBlock mk -> ShowS
$cshow :: forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk -> String
show :: Ticked LedgerState ByronSpecBlock mk -> String
$cshowList :: forall (mk :: MapKind).
[Ticked LedgerState ByronSpecBlock mk] -> ShowS
showList :: [Ticked LedgerState ByronSpecBlock mk] -> ShowS
Show, Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
(Ticked LedgerState ByronSpecBlock mk
 -> Ticked LedgerState ByronSpecBlock mk -> Bool)
-> (Ticked LedgerState ByronSpecBlock mk
    -> Ticked LedgerState ByronSpecBlock mk -> Bool)
-> Eq (Ticked LedgerState ByronSpecBlock mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
$c== :: forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
== :: Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
$c/= :: forall (mk :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
/= :: Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk -> Bool
Eq)
  deriving Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
Proxy (Ticked LedgerState ByronSpecBlock mk) -> String
(Context
 -> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked LedgerState ByronSpecBlock mk) -> String)
-> NoThunks (Ticked LedgerState ByronSpecBlock mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (Ticked LedgerState ByronSpecBlock mk) -> String
$cnoThunks :: forall (mk :: MapKind).
Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Ticked LedgerState ByronSpecBlock mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (Ticked LedgerState ByronSpecBlock mk) -> String
showTypeOf :: Proxy (Ticked LedgerState ByronSpecBlock mk) -> String
NoThunks via AllowThunk (Ticked LedgerState ByronSpecBlock mk)

type instance AuxLedgerEvent ByronSpecBlock = VoidLedgerEvent

instance IsLedger LedgerState ByronSpecBlock where
  type LedgerErr LedgerState ByronSpecBlock = ByronSpecLedgerError

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> SlotNo
-> LedgerState ByronSpecBlock EmptyMK
-> LedgerResult
     ByronSpecBlock (Ticked LedgerState ByronSpecBlock DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
_evs LedgerCfg LedgerState ByronSpecBlock
cfg SlotNo
slot (ByronSpecLedgerState Maybe SlotNo
tip State CHAIN
state) =
    Ticked LedgerState ByronSpecBlock DiffMK
-> LedgerResult
     ByronSpecBlock (Ticked LedgerState ByronSpecBlock DiffMK)
forall a l. a -> LedgerResult l a
pureLedgerResult (Ticked LedgerState ByronSpecBlock DiffMK
 -> LedgerResult
      ByronSpecBlock (Ticked LedgerState ByronSpecBlock DiffMK))
-> Ticked LedgerState ByronSpecBlock DiffMK
-> LedgerResult
     ByronSpecBlock (Ticked LedgerState ByronSpecBlock DiffMK)
forall a b. (a -> b) -> a -> b
$
      TickedByronSpecLedgerState
        { untickedByronSpecLedgerTip :: Maybe SlotNo
untickedByronSpecLedgerTip = Maybe SlotNo
tip
        , tickedByronSpecLedgerState :: State CHAIN
tickedByronSpecLedgerState =
            ByronSpecGenesis -> Slot -> State CHAIN -> State CHAIN
Rules.applyChainTick
              LedgerCfg LedgerState ByronSpecBlock
ByronSpecGenesis
cfg
              (SlotNo -> Slot
toByronSpecSlotNo SlotNo
slot)
              State CHAIN
state
        }

{-------------------------------------------------------------------------------
  Ledger Tables
-------------------------------------------------------------------------------}

type instance TxIn ByronSpecBlock = Void
type instance TxOut ByronSpecBlock = Void

instance LedgerTablesAreTrivial LedgerState ByronSpecBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState ByronSpecBlock mk -> LedgerState ByronSpecBlock mk'
convertMapKind (ByronSpecLedgerState Maybe SlotNo
x State CHAIN
y) = Maybe SlotNo -> State CHAIN -> LedgerState ByronSpecBlock mk'
forall (mk :: MapKind).
Maybe SlotNo -> State CHAIN -> LedgerState ByronSpecBlock mk
ByronSpecLedgerState Maybe SlotNo
x State CHAIN
y
instance LedgerTablesAreTrivial (Ticked LedgerState) ByronSpecBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk'
convertMapKind (TickedByronSpecLedgerState Maybe SlotNo
x State CHAIN
y) =
    Maybe SlotNo
-> State CHAIN -> Ticked LedgerState ByronSpecBlock mk'
forall (mk :: MapKind).
Maybe SlotNo -> State CHAIN -> Ticked LedgerState ByronSpecBlock mk
TickedByronSpecLedgerState Maybe SlotNo
x State CHAIN
y
deriving via
  Void
  instance
    IndexedMemPack LedgerState ByronSpecBlock Void
instance HasLedgerTables LedgerState ByronSpecBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState ByronSpecBlock mk -> LedgerTables ByronSpecBlock mk
projectLedgerTables LedgerState ByronSpecBlock mk
_ = LedgerTables ByronSpecBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState ByronSpecBlock any
-> LedgerTables ByronSpecBlock mk -> LedgerState ByronSpecBlock mk
withLedgerTables LedgerState ByronSpecBlock any
st LedgerTables ByronSpecBlock mk
_ = LedgerState ByronSpecBlock any -> LedgerState ByronSpecBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState ByronSpecBlock mk -> LedgerState ByronSpecBlock mk'
forall (l :: * -> LedgerStateKind) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind LedgerState ByronSpecBlock any
st
instance HasLedgerTables (Ticked LedgerState) ByronSpecBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState ByronSpecBlock mk
-> LedgerTables ByronSpecBlock mk
projectLedgerTables Ticked LedgerState ByronSpecBlock mk
_ = LedgerTables ByronSpecBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState ByronSpecBlock any
-> LedgerTables ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk
withLedgerTables Ticked LedgerState ByronSpecBlock any
st LedgerTables ByronSpecBlock mk
_ = Ticked LedgerState ByronSpecBlock any
-> Ticked LedgerState ByronSpecBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState ByronSpecBlock mk
-> Ticked LedgerState ByronSpecBlock mk'
forall (l :: * -> LedgerStateKind) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind Ticked LedgerState ByronSpecBlock any
st

{-------------------------------------------------------------------------------
  Applying blocks
-------------------------------------------------------------------------------}

instance ApplyBlock LedgerState ByronSpecBlock where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> ByronSpecBlock
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> Except
     (LedgerErr LedgerState ByronSpecBlock)
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
_ ComputeLedgerEvents
_ LedgerCfg LedgerState ByronSpecBlock
cfg ByronSpecBlock
block (TickedByronSpecLedgerState Maybe SlotNo
_tip State CHAIN
state) =
    (NonEmpty (PredicateFailure CHAIN)
 -> LedgerErr LedgerState ByronSpecBlock)
-> Except
     (NonEmpty (PredicateFailure CHAIN))
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> Except
     (LedgerErr LedgerState ByronSpecBlock)
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept NonEmpty (PredicateFailure CHAIN)
-> LedgerErr LedgerState ByronSpecBlock
NonEmpty (PredicateFailure CHAIN) -> ByronSpecLedgerError
ByronSpecLedgerError (Except
   (NonEmpty (PredicateFailure CHAIN))
   (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
 -> Except
      (LedgerErr LedgerState ByronSpecBlock)
      (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)))
-> Except
     (NonEmpty (PredicateFailure CHAIN))
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> Except
     (LedgerErr LedgerState ByronSpecBlock)
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
forall a b. (a -> b) -> a -> b
$
      (State CHAIN
 -> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> Except
     (NonEmpty (PredicateFailure CHAIN))
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
forall a b.
(a -> b)
-> ExceptT (NonEmpty (PredicateFailure CHAIN)) Identity a
-> ExceptT (NonEmpty (PredicateFailure CHAIN)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LedgerState ByronSpecBlock DiffMK
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState ByronSpecBlock DiffMK
 -> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
    -> LedgerState ByronSpecBlock DiffMK)
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SlotNo -> State CHAIN -> LedgerState ByronSpecBlock DiffMK
forall (mk :: MapKind).
Maybe SlotNo -> State CHAIN -> LedgerState ByronSpecBlock mk
ByronSpecLedgerState (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (ByronSpecBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ByronSpecBlock
block))) (ExceptT (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
 -> Except
      (NonEmpty (PredicateFailure CHAIN))
      (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> Except
     (NonEmpty (PredicateFailure CHAIN))
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
forall a b. (a -> b) -> a -> b
$ -- Note that the CHAIN rule also applies the chain tick. So even
      -- though the ledger we received has already been ticked with
      -- 'applyChainTick', we do it again as part of CHAIN. This is safe, as
      -- it is idempotent. If we wanted to avoid the repeated tick, we would
      -- have to call the subtransitions of CHAIN (except for ticking).
        ByronSpecGenesis -> LiftedRule CHAIN
Rules.liftCHAIN
          LedgerCfg LedgerState ByronSpecBlock
ByronSpecGenesis
cfg
          (ByronSpecBlock -> Block
byronSpecBlock ByronSpecBlock
block)
          State CHAIN
state

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> ByronSpecBlock
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> Except
     (LedgerErr LedgerState ByronSpecBlock)
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> ByronSpecBlock
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> Except
     (LedgerErr LedgerState ByronSpecBlock)
     (LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
forall (l :: * -> LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
defaultApplyBlockLedgerResult
  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> ByronSpecBlock
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
reapplyBlockLedgerResult =
    (LedgerErr LedgerState ByronSpecBlock
 -> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg LedgerState ByronSpecBlock
-> ByronSpecBlock
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
forall (l :: * -> LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l blk -> LedgerResult blk (l blk DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
defaultReapplyBlockLedgerResult (String
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
forall a. HasCallStack => String -> a
error (String
 -> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK))
-> (ByronSpecLedgerError -> String)
-> ByronSpecLedgerError
-> LedgerResult ByronSpecBlock (LedgerState ByronSpecBlock DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"reapplyBlockLedgerResult: unexpected error " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (ByronSpecLedgerError -> String)
-> ByronSpecLedgerError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronSpecLedgerError -> String
forall a. Show a => a -> String
show)

instance GetBlockKeySets ByronSpecBlock where
  getBlockKeySets :: ByronSpecBlock -> LedgerTables ByronSpecBlock KeysMK
getBlockKeySets ByronSpecBlock
_ = LedgerTables ByronSpecBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

{-------------------------------------------------------------------------------
  CommonProtocolParams
-------------------------------------------------------------------------------}

instance CommonProtocolParams ByronSpecBlock where
  maxHeaderSize :: forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> Word32
maxHeaderSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState ByronSpecBlock mk -> Natural)
-> LedgerState ByronSpecBlock mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams -> Natural
Spec._maxHdrSz (PParams -> Natural)
-> (LedgerState ByronSpecBlock mk -> PParams)
-> LedgerState ByronSpecBlock mk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronSpecBlock mk -> PParams
forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> PParams
getPParams
  maxTxSize :: forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> Word32
maxTxSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState ByronSpecBlock mk -> Natural)
-> LedgerState ByronSpecBlock mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams -> Natural
Spec._maxTxSz (PParams -> Natural)
-> (LedgerState ByronSpecBlock mk -> PParams)
-> LedgerState ByronSpecBlock mk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronSpecBlock mk -> PParams
forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> PParams
getPParams

getPParams :: LedgerState ByronSpecBlock mk -> Spec.PParams
getPParams :: forall (mk :: MapKind). LedgerState ByronSpecBlock mk -> PParams
getPParams =
  UPIState -> PParams
Spec.protocolParameters
    (UPIState -> PParams)
-> (LedgerState ByronSpecBlock mk -> UPIState)
-> LedgerState ByronSpecBlock mk
-> PParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> UPIState
GetChainState UPIState
getChainStateUPIState
    ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
 -> UPIState)
-> (LedgerState ByronSpecBlock mk
    -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> LedgerState ByronSpecBlock mk
-> UPIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronSpecBlock mk
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
LedgerState ByronSpecBlock mk -> State CHAIN
forall (mk :: MapKind).
LedgerState ByronSpecBlock mk -> State CHAIN
byronSpecLedgerState