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

{-# OPTIONS -Wno-orphans #-}

module Ouroboros.Consensus.ByronSpec.Ledger.Ledger (
    ByronSpecLedgerError (..)
  , initByronSpecLedgerState
    -- * Type family instances
  , LedgerState (..)
  , 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           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.Ticked
import           Ouroboros.Consensus.Util ((..:))

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

data instance LedgerState ByronSpecBlock = ByronSpecLedgerState {
      -- | Tip of the ledger (most recently applied block, if any)
      --
      -- The spec state stores the last applied /hash/, but not the /slot/.
      LedgerState ByronSpecBlock -> Maybe SlotNo
byronSpecLedgerTip :: Maybe SlotNo

      -- | The spec state proper
    , LedgerState ByronSpecBlock -> State CHAIN
byronSpecLedgerState :: Spec.State Spec.CHAIN
    }
  deriving stock (Int -> LedgerState ByronSpecBlock -> ShowS
[LedgerState ByronSpecBlock] -> ShowS
LedgerState ByronSpecBlock -> String
(Int -> LedgerState ByronSpecBlock -> ShowS)
-> (LedgerState ByronSpecBlock -> String)
-> ([LedgerState ByronSpecBlock] -> ShowS)
-> Show (LedgerState ByronSpecBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerState ByronSpecBlock -> ShowS
showsPrec :: Int -> LedgerState ByronSpecBlock -> ShowS
$cshow :: LedgerState ByronSpecBlock -> String
show :: LedgerState ByronSpecBlock -> String
$cshowList :: [LedgerState ByronSpecBlock] -> ShowS
showList :: [LedgerState ByronSpecBlock] -> ShowS
Show, LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool
(LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool)
-> (LedgerState ByronSpecBlock
    -> LedgerState ByronSpecBlock -> Bool)
-> Eq (LedgerState ByronSpecBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool
== :: LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool
$c/= :: LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool
/= :: LedgerState ByronSpecBlock -> LedgerState ByronSpecBlock -> Bool
Eq, (forall x.
 LedgerState ByronSpecBlock -> Rep (LedgerState ByronSpecBlock) x)
-> (forall x.
    Rep (LedgerState ByronSpecBlock) x -> LedgerState ByronSpecBlock)
-> Generic (LedgerState ByronSpecBlock)
forall x.
Rep (LedgerState ByronSpecBlock) x -> LedgerState ByronSpecBlock
forall x.
LedgerState ByronSpecBlock -> Rep (LedgerState ByronSpecBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
LedgerState ByronSpecBlock -> Rep (LedgerState ByronSpecBlock) x
from :: forall x.
LedgerState ByronSpecBlock -> Rep (LedgerState ByronSpecBlock) x
$cto :: forall x.
Rep (LedgerState ByronSpecBlock) x -> LedgerState ByronSpecBlock
to :: forall x.
Rep (LedgerState ByronSpecBlock) x -> LedgerState ByronSpecBlock
Generic)
  deriving anyclass ([LedgerState ByronSpecBlock] -> Encoding
LedgerState ByronSpecBlock -> Encoding
(LedgerState ByronSpecBlock -> Encoding)
-> (forall s. Decoder s (LedgerState ByronSpecBlock))
-> ([LedgerState ByronSpecBlock] -> Encoding)
-> (forall s. Decoder s [LedgerState ByronSpecBlock])
-> Serialise (LedgerState ByronSpecBlock)
forall s. Decoder s [LedgerState ByronSpecBlock]
forall s. Decoder s (LedgerState ByronSpecBlock)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: LedgerState ByronSpecBlock -> Encoding
encode :: LedgerState ByronSpecBlock -> Encoding
$cdecode :: forall s. Decoder s (LedgerState ByronSpecBlock)
decode :: forall s. Decoder s (LedgerState ByronSpecBlock)
$cencodeList :: [LedgerState ByronSpecBlock] -> Encoding
encodeList :: [LedgerState ByronSpecBlock] -> Encoding
$cdecodeList :: forall s. Decoder s [LedgerState ByronSpecBlock]
decodeList :: forall s. Decoder s [LedgerState ByronSpecBlock]
Serialise)
  deriving Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo)
Proxy (LedgerState ByronSpecBlock) -> String
(Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState ByronSpecBlock) -> String)
-> NoThunks (LedgerState ByronSpecBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState ByronSpecBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (LedgerState ByronSpecBlock) -> String
showTypeOf :: Proxy (LedgerState ByronSpecBlock) -> String
NoThunks via AllowThunk (LedgerState ByronSpecBlock)

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

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

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

  applyChainTickLedgerResult :: LedgerCfg (LedgerState ByronSpecBlock)
-> SlotNo
-> LedgerState ByronSpecBlock
-> LedgerResult
     (LedgerState ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock))
applyChainTickLedgerResult LedgerCfg (LedgerState ByronSpecBlock)
cfg SlotNo
slot (ByronSpecLedgerState Maybe SlotNo
tip State CHAIN
state) =
        Ticked (LedgerState ByronSpecBlock)
-> LedgerResult
     (LedgerState ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock))
forall a l. a -> LedgerResult l a
pureLedgerResult
      (Ticked (LedgerState ByronSpecBlock)
 -> LedgerResult
      (LedgerState ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock)))
-> Ticked (LedgerState ByronSpecBlock)
-> LedgerResult
     (LedgerState ByronSpecBlock) (Ticked (LedgerState ByronSpecBlock))
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
          }

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

instance ApplyBlock (LedgerState ByronSpecBlock) ByronSpecBlock where
  applyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
applyBlockLedgerResult 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))
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
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))
 -> Except
      (LedgerErr (LedgerState ByronSpecBlock))
      (LedgerResult
         (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)))
-> Except
     (NonEmpty ChainPredicateFailure)
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
forall a b. (a -> b) -> a -> b
$ (State CHAIN
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN))
     Identity
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
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
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)
forall a l. a -> LedgerResult l a
pureLedgerResult (LedgerState ByronSpecBlock
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
-> ((Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
    -> LedgerState ByronSpecBlock)
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SlotNo -> State CHAIN -> LedgerState ByronSpecBlock
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)))
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN)) Identity (State CHAIN)
-> ExceptT
     (NonEmpty (PredicateFailure CHAIN))
     Identity
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
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

  reapplyBlockLedgerResult :: HasCallStack =>
LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)
reapplyBlockLedgerResult =
      -- The spec doesn't have a "reapply" mode
      Except
  ByronSpecLedgerError
  (LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)
forall a b. Except a b -> b
dontExpectError (Except
   ByronSpecLedgerError
   (LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
 -> LedgerResult
      (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
-> (ByronSpecGenesis
    -> ByronSpecBlock
    -> Ticked (LedgerState ByronSpecBlock)
    -> Except
         ByronSpecLedgerError
         (LedgerResult
            (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)))
-> ByronSpecGenesis
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> LedgerResult
     (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: LedgerCfg (LedgerState ByronSpecBlock)
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     (LedgerErr (LedgerState ByronSpecBlock))
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
ByronSpecGenesis
-> ByronSpecBlock
-> Ticked (LedgerState ByronSpecBlock)
-> Except
     ByronSpecLedgerError
     (LedgerResult
        (LedgerState ByronSpecBlock) (LedgerState ByronSpecBlock))
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
LedgerCfg l
-> blk -> Ticked l -> Except (LedgerErr l) (LedgerResult l l)
applyBlockLedgerResult
    where
      dontExpectError :: Except a b -> b
      dontExpectError :: forall a b. Except a b -> b
dontExpectError Except a b
mb = case Except a b -> Either a b
forall e a. Except e a -> Either e a
runExcept Except a b
mb of
        Left  a
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"reapplyBlockLedgerResult: unexpected error"
        Right b
b -> b
b

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

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

getPParams :: LedgerState ByronSpecBlock -> Spec.PParams
getPParams :: LedgerState ByronSpecBlock -> PParams
getPParams =
      UPIState -> PParams
Spec.protocolParameters
    (UPIState -> PParams)
-> (LedgerState ByronSpecBlock -> UPIState)
-> LedgerState ByronSpecBlock
-> 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
    -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> LedgerState ByronSpecBlock
-> UPIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState ByronSpecBlock
-> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
LedgerState ByronSpecBlock -> State CHAIN
byronSpecLedgerState