{-# LANGUAGE DataKinds #-}
{-# 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)

instance IsLedger (LedgerState ByronSpecBlock) where
  type LedgerErr (LedgerState ByronSpecBlock) = ByronSpecLedgerError

  type
    AuxLedgerEvent (LedgerState ByronSpecBlock) =
      VoidLedgerEvent (LedgerState ByronSpecBlock)

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronSpecBlock)
-> SlotNo
-> LedgerState ByronSpecBlock EmptyMK
-> LedgerResult
     (LedgerState 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
     (LedgerState ByronSpecBlock)
     (Ticked (LedgerState ByronSpecBlock) DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult (Ticked (LedgerState ByronSpecBlock) DiffMK
 -> LedgerResult
      (LedgerState ByronSpecBlock)
      (Ticked (LedgerState ByronSpecBlock) DiffMK))
-> Ticked (LedgerState ByronSpecBlock) DiffMK
-> LedgerResult
     (LedgerState 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 (LedgerState ByronSpecBlock) = Void
type instance TxOut (LedgerState 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 EmptyMK) Void
deriving via
  TrivialLedgerTables (LedgerState ByronSpecBlock)
  instance
    HasLedgerTables (LedgerState ByronSpecBlock)
deriving via
  TrivialLedgerTables (Ticked (LedgerState ByronSpecBlock))
  instance
    HasLedgerTables (Ticked (LedgerState ByronSpecBlock))
deriving via
  TrivialLedgerTables (LedgerState ByronSpecBlock)
  instance
    CanStowLedgerTables (LedgerState ByronSpecBlock)

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

instance ApplyBlock (LedgerState ByronSpecBlock) ByronSpecBlock where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
_ ComputeLedgerEvents
_ LedgerCfg (LedgerState ByronSpecBlock)
cfg ByronSpecBlock
block (TickedByronSpecLedgerState Maybe SlotNo
_tip State CHAIN
state) =
    (NonEmpty ChainPredicateFailure
 -> LedgerErr (LedgerState ByronSpecBlock))
-> Except
     (NonEmpty ChainPredicateFailure)
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept NonEmpty ChainPredicateFailure
-> LedgerErr (LedgerState ByronSpecBlock)
NonEmpty (PredicateFailure CHAIN) -> ByronSpecLedgerError
ByronSpecLedgerError (Except
   (NonEmpty ChainPredicateFailure)
   (LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
 -> Except
      (LedgerErr (LedgerState ByronSpecBlock))
      (LedgerResult
         (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK)))
-> Except
     (NonEmpty ChainPredicateFailure)
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
forall a b. (a -> b) -> a -> b
$
      (State CHAIN
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN))
     Identity
     (LedgerResult
        (LedgerState 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
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK)
forall a (l :: LedgerStateKind). a -> LedgerResult l a
pureLedgerResult (LedgerState ByronSpecBlock DiffMK
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
    -> LedgerState ByronSpecBlock DiffMK)
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> LedgerResult
     (LedgerState 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)
 -> ExceptT
      (NonEmpty (PredicateFailure CHAIN))
      Identity
      (LedgerResult
         (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK)))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN))
     Identity
     (LedgerResult
        (LedgerState 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
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock) ValuesMK
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock 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 ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock) ValuesMK
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK)
reapplyBlockLedgerResult =
    (LedgerErr (LedgerState ByronSpecBlock)
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock) ValuesMK
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock 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 (String
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK)
forall a. HasCallStack => String -> a
error (String
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock DiffMK))
-> (ByronSpecLedgerError -> String)
-> ByronSpecLedgerError
-> LedgerResult
     (LedgerState 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)

  getBlockKeySets :: ByronSpecBlock -> LedgerTables (LedgerState ByronSpecBlock) KeysMK
getBlockKeySets ByronSpecBlock
_ = LedgerTables (LedgerState ByronSpecBlock) KeysMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l 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