{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | Interface to the ledger layer
--
-- This module defines how to apply blocks to a ledger state, and re-exports
-- (from "Ouroboros.Consensus.Ledger.Basics") how to tick ledger states. These
-- are the two main operations we can do with a 'LedgerState'.
module Ouroboros.Consensus.Ledger.Abstract
  ( -- * Type-level validation marker
    Validated

    -- * Apply block
  , ApplyBlock (..)
  , GetBlockKeySets (..)
  , ComputeLedgerEvents (..)
  , UpdateLedger
  , defaultApplyBlockLedgerResult
  , defaultReapplyBlockLedgerResult

    -- * Derived
  , applyLedgerBlock
  , foldLedger
  , reapplyLedgerBlock
  , refoldLedger
  , tickThenApply
  , tickThenApplyLedgerResult
  , tickThenReapply
  , tickThenReapplyLedgerResult

    -- ** Short-hand
  , ledgerTipHash
  , ledgerTipPoint
  , ledgerTipSlot

    -- * Re-exports
  , module Ouroboros.Consensus.Ledger.Basics
  , module Ouroboros.Consensus.Ledger.Tables
  , module Ouroboros.Consensus.Ledger.Tables.MapKind
  ) where

import Control.Monad.Except
import qualified Control.State.Transition.Extended as STS
import Data.Kind (Type)
import GHC.Stack (HasCallStack)
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.Tables
import Ouroboros.Consensus.Ledger.Tables.MapKind
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Ticked
import Ouroboros.Consensus.Util

-- | " Validated " transaction or block
--
-- The ledger defines how to validate transactions and blocks. It's possible the
-- type before and after validation may be distinct (eg Alonzo transactions),
-- which originally motivated this family.
--
-- We also gain the related benefit that certain interface functions, such as
-- those that /reapply/ blocks, can have a more precise type now. TODO
--
-- Similarly, the Node-to-Client mini protocols can explicitly indicate that the
-- client trusts the blocks from the local server, by having the server send
-- 'Validated' blocks to the client. TODO
--
-- Note that validation has different implications for a transaction than for a
-- block. In particular, a validated transaction can be " reapplied " to
-- different ledger states, whereas a validated block must only be " reapplied "
-- to the exact same ledger state (eg as part of rebuilding from an on-disk
-- ledger snapshot).
--
-- Since the ledger defines validation, see the ledger details for concrete
-- examples of what determines the validity (wrt to a 'LedgerState') of a
-- transaction and/or block. Example properties include: a transaction's claimed
-- inputs exist and are still unspent, a block carries a sufficient
-- cryptographic signature, etc.
data family Validated x :: Type

{-------------------------------------------------------------------------------
  Apply block to ledger state
-------------------------------------------------------------------------------}

class
  ( IsLedger l blk
  , HeaderHash (l blk) ~ HeaderHash blk
  , HasHeader blk
  , HasHeader (Header blk)
  , HasLedgerTables l blk
  , HasLedgerTables (Ticked l) blk
  , GetBlockKeySets blk
  ) =>
  ApplyBlock l blk
  where
  -- | Apply a block to the ledger state.
  --
  -- This is passed the ledger state ticked to the slot of the given block, so
  -- 'applyChainTickLedgerResult' has already been called.
  --
  -- Users of this function can set any validation level allowed by the
  -- @small-steps@ package. See "Control.State.Transition.Extended".
  applyBlockLedgerResultWithValidation ::
    HasCallStack =>
    STS.ValidationPolicy ->
    ComputeLedgerEvents ->
    LedgerCfg l blk ->
    blk ->
    Ticked l blk ValuesMK ->
    Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))

  -- | Apply a block to the ledger state.
  --
  -- This is passed the ledger state ticked to the slot of the given block, so
  -- 'applyChainTickLedgerResult' has already been called.
  --
  -- This function will use 'ValidateAll' policy for calling the ledger rules.
  applyBlockLedgerResult ::
    HasCallStack =>
    ComputeLedgerEvents ->
    LedgerCfg l blk ->
    blk ->
    Ticked l blk ValuesMK ->
    Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))

  -- | Re-apply a block to the very same ledger state it was applied in before.
  --
  -- Since a block can only be applied to a single, specific, ledger state,
  -- if we apply a previously applied block again it will be applied in the
  -- very same ledger state, and therefore can't possibly fail.
  --
  -- It is worth noting that since we already know that the block is valid in
  -- the provided ledger state, the ledger layer should not perform /any/
  -- validation checks. Thus this function will call the ledger rules with
  -- 'ValidateNone' policy.
  reapplyBlockLedgerResult ::
    HasCallStack =>
    ComputeLedgerEvents ->
    LedgerCfg l blk ->
    blk ->
    Ticked l blk ValuesMK ->
    LedgerResult blk (l blk DiffMK)

class GetBlockKeySets blk where
  -- | Given a block, get the key-sets that we need to apply it to a ledger
  -- state.
  getBlockKeySets :: blk -> LedgerTables blk KeysMK

defaultApplyBlockLedgerResult ::
  (HasCallStack, ApplyBlock l blk) =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  Ticked l blk ValuesMK ->
  Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
defaultApplyBlockLedgerResult :: forall (l :: StateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
defaultApplyBlockLedgerResult =
  ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
STS.ValidateAll

defaultReapplyBlockLedgerResult ::
  (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 :: forall (l :: StateKind) 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 LedgerErr l blk -> LedgerResult blk (l blk DiffMK)
throwReapplyError =
  ((LedgerErr l blk -> LedgerResult blk (l blk DiffMK))
-> (LedgerResult blk (l blk DiffMK)
    -> LedgerResult blk (l blk DiffMK))
-> Either (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
-> LedgerResult blk (l blk DiffMK)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either LedgerErr l blk -> LedgerResult blk (l blk DiffMK)
throwReapplyError LedgerResult blk (l blk DiffMK) -> LedgerResult blk (l blk DiffMK)
forall a. a -> a
id (Either (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
 -> LedgerResult blk (l blk DiffMK))
-> (Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
    -> Either (LedgerErr l blk) (LedgerResult blk (l blk DiffMK)))
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
-> LedgerResult blk (l blk DiffMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
-> Either (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
forall e a. Except e a -> Either e a
runExcept)
    (Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
 -> LedgerResult blk (l blk DiffMK))
-> (ComputeLedgerEvents
    -> LedgerCfg l blk
    -> blk
    -> Ticked l blk ValuesMK
    -> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
STS.ValidateNone

-- | Interaction with the ledger layer
class ApplyBlock LedgerState blk => UpdateLedger blk

{-------------------------------------------------------------------------------
  Derived functionality
-------------------------------------------------------------------------------}

-- | 'lrResult' after 'applyBlockLedgerResult'
applyLedgerBlock ::
  forall l blk.
  (ApplyBlock l blk, HasCallStack) =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  Ticked l blk ValuesMK ->
  Except (LedgerErr l blk) (l blk DiffMK)
applyLedgerBlock :: forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (l blk DiffMK)
applyLedgerBlock = (LedgerResult blk (l blk DiffMK) -> l blk DiffMK)
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
forall a b.
(a -> b)
-> ExceptT (LedgerErr l blk) Identity a
-> ExceptT (LedgerErr l blk) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerResult blk (l blk DiffMK) -> l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult (ExceptT
   (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
 -> ExceptT (LedgerErr l blk) Identity (l blk DiffMK))
-> (ComputeLedgerEvents
    -> LedgerCfg l blk
    -> blk
    -> Ticked l blk ValuesMK
    -> ExceptT
         (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResult

-- | 'lrResult' after 'reapplyBlockLedgerResult'
reapplyLedgerBlock ::
  forall l blk.
  (ApplyBlock l blk, HasCallStack) =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  Ticked l blk ValuesMK ->
  l blk DiffMK
reapplyLedgerBlock :: forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> Ticked l blk ValuesMK -> l blk DiffMK
reapplyLedgerBlock = LedgerResult blk (l blk DiffMK) -> l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult (LedgerResult blk (l blk DiffMK) -> l blk DiffMK)
-> (ComputeLedgerEvents
    -> LedgerCfg l blk
    -> blk
    -> Ticked l blk ValuesMK
    -> LedgerResult blk (l blk DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> l blk DiffMK
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
reapplyBlockLedgerResult

tickThenApplyLedgerResult ::
  ApplyBlock l blk =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  l blk ValuesMK ->
  Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
tickThenApplyLedgerResult :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
tickThenApplyLedgerResult ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
blk l blk ValuesMK
l = do
  let lrTick :: LedgerResult blk (Ticked l blk DiffMK)
lrTick = ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
forall (l :: StateKind) blk.
IsLedger l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg l blk
cfg (blk -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot blk
blk) (l blk ValuesMK -> l blk EmptyMK
forall (l :: StateKind) blk (mk :: MapKind).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables l blk ValuesMK
l)
  lrBlock <-
    ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResult
      ComputeLedgerEvents
evs
      LedgerCfg l blk
cfg
      blk
blk
      (l blk ValuesMK
-> LedgerTables blk KeysMK
-> Ticked l blk DiffMK
-> Ticked l blk ValuesMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK
-> LedgerTables blk KeysMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffForKeys l blk ValuesMK
l (blk -> LedgerTables blk KeysMK
forall blk. GetBlockKeySets blk => blk -> LedgerTables blk KeysMK
getBlockKeySets blk
blk) (LedgerResult blk (Ticked l blk DiffMK) -> Ticked l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult LedgerResult blk (Ticked l blk DiffMK)
lrTick))
  pure
    LedgerResult
      { lrEvents = lrEvents lrTick <> lrEvents lrBlock
      , lrResult = prependDiffs (lrResult lrTick) (lrResult lrBlock)
      }

tickThenReapplyLedgerResult ::
  forall l blk.
  ApplyBlock l blk =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  l blk ValuesMK ->
  LedgerResult blk (l blk DiffMK)
tickThenReapplyLedgerResult :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
tickThenReapplyLedgerResult ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
blk l blk ValuesMK
l =
  let lrTick :: LedgerResult blk (Ticked l blk DiffMK)
lrTick = ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
forall (l :: StateKind) blk.
IsLedger l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg l blk
cfg (blk -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot blk
blk) (l blk ValuesMK -> l blk EmptyMK
forall (l :: StateKind) blk (mk :: MapKind).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables l blk ValuesMK
l)
      lrBlock :: LedgerResult blk (l blk DiffMK)
lrBlock =
        ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
reapplyBlockLedgerResult
          ComputeLedgerEvents
evs
          LedgerCfg l blk
cfg
          blk
blk
          (l blk ValuesMK
-> LedgerTables blk KeysMK
-> Ticked l blk DiffMK
-> Ticked l blk ValuesMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK
-> LedgerTables blk KeysMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffForKeys l blk ValuesMK
l (blk -> LedgerTables blk KeysMK
forall blk. GetBlockKeySets blk => blk -> LedgerTables blk KeysMK
getBlockKeySets blk
blk) (LedgerResult blk (Ticked l blk DiffMK) -> Ticked l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult LedgerResult blk (Ticked l blk DiffMK)
lrTick))
   in LedgerResult
        { lrEvents :: [AuxLedgerEvent blk]
lrEvents = LedgerResult blk (Ticked l blk DiffMK) -> [AuxLedgerEvent blk]
forall blk a. LedgerResult blk a -> [AuxLedgerEvent blk]
lrEvents LedgerResult blk (Ticked l blk DiffMK)
lrTick [AuxLedgerEvent blk]
-> [AuxLedgerEvent blk] -> [AuxLedgerEvent blk]
forall a. Semigroup a => a -> a -> a
<> LedgerResult blk (l blk DiffMK) -> [AuxLedgerEvent blk]
forall blk a. LedgerResult blk a -> [AuxLedgerEvent blk]
lrEvents LedgerResult blk (l blk DiffMK)
lrBlock
        , lrResult :: l blk DiffMK
lrResult = Ticked l blk DiffMK -> l blk DiffMK -> l blk DiffMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk DiffMK -> l' blk DiffMK -> l' blk DiffMK
prependDiffs (LedgerResult blk (Ticked l blk DiffMK) -> Ticked l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult LedgerResult blk (Ticked l blk DiffMK)
lrTick) (LedgerResult blk (l blk DiffMK) -> l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult LedgerResult blk (l blk DiffMK)
lrBlock)
        }

tickThenApply ::
  forall l blk.
  ApplyBlock l blk =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  l blk ValuesMK ->
  Except (LedgerErr l blk) (l blk DiffMK)
tickThenApply :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> Except (LedgerErr l blk) (l blk DiffMK)
tickThenApply = (LedgerResult blk (l blk DiffMK) -> l blk DiffMK)
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
forall a b.
(a -> b)
-> ExceptT (LedgerErr l blk) Identity a
-> ExceptT (LedgerErr l blk) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerResult blk (l blk DiffMK) -> l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult (ExceptT
   (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
 -> ExceptT (LedgerErr l blk) Identity (l blk DiffMK))
-> (ComputeLedgerEvents
    -> LedgerCfg l blk
    -> blk
    -> l blk ValuesMK
    -> ExceptT
         (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> ExceptT
     (LedgerErr l blk) Identity (LedgerResult blk (l blk DiffMK))
forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
tickThenApplyLedgerResult

tickThenReapply ::
  forall l blk.
  ApplyBlock l blk =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  l blk ValuesMK ->
  l blk DiffMK
tickThenReapply :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> l blk ValuesMK -> l blk DiffMK
tickThenReapply = LedgerResult blk (l blk DiffMK) -> l blk DiffMK
forall blk a. LedgerResult blk a -> a
lrResult (LedgerResult blk (l blk DiffMK) -> l blk DiffMK)
-> (ComputeLedgerEvents
    -> LedgerCfg l blk
    -> blk
    -> l blk ValuesMK
    -> LedgerResult blk (l blk DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> l blk DiffMK
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> LedgerResult blk (l blk DiffMK)
tickThenReapplyLedgerResult

foldLedger ::
  ApplyBlock l blk =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  [blk] ->
  l blk ValuesMK ->
  Except (LedgerErr l blk) (l blk ValuesMK)
foldLedger :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> [blk]
-> l blk ValuesMK
-> Except (LedgerErr l blk) (l blk ValuesMK)
foldLedger ComputeLedgerEvents
evs LedgerCfg l blk
cfg =
  (blk
 -> l blk ValuesMK
 -> ExceptT (LedgerErr l blk) Identity (l blk ValuesMK))
-> [blk]
-> l blk ValuesMK
-> ExceptT (LedgerErr l blk) Identity (l blk ValuesMK)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> [a] -> b -> m b
repeatedlyM
    (\blk
blk l blk ValuesMK
state -> l blk ValuesMK
-> LedgerTables blk KeysMK -> l blk DiffMK -> l blk ValuesMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK
-> LedgerTables blk KeysMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffForKeys l blk ValuesMK
state (blk -> LedgerTables blk KeysMK
forall blk. GetBlockKeySets blk => blk -> LedgerTables blk KeysMK
getBlockKeySets blk
blk) (l blk DiffMK -> l blk ValuesMK)
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
-> ExceptT (LedgerErr l blk) Identity (l blk ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> ExceptT (LedgerErr l blk) Identity (l blk DiffMK)
forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> l blk ValuesMK
-> Except (LedgerErr l blk) (l blk DiffMK)
tickThenApply ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
blk l blk ValuesMK
state)

refoldLedger ::
  ApplyBlock l blk =>
  ComputeLedgerEvents -> LedgerCfg l blk -> [blk] -> l blk ValuesMK -> l blk ValuesMK
refoldLedger :: forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk -> [blk] -> l blk ValuesMK -> l blk ValuesMK
refoldLedger ComputeLedgerEvents
evs LedgerCfg l blk
cfg =
  (blk -> l blk ValuesMK -> l blk ValuesMK)
-> [blk] -> l blk ValuesMK -> l blk ValuesMK
forall a b. (a -> b -> b) -> [a] -> b -> b
repeatedly
    (\blk
blk l blk ValuesMK
state -> l blk ValuesMK
-> LedgerTables blk KeysMK -> l blk DiffMK -> l blk ValuesMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK
-> LedgerTables blk KeysMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffForKeys l blk ValuesMK
state (blk -> LedgerTables blk KeysMK
forall blk. GetBlockKeySets blk => blk -> LedgerTables blk KeysMK
getBlockKeySets blk
blk) (l blk DiffMK -> l blk ValuesMK) -> l blk DiffMK -> l blk ValuesMK
forall a b. (a -> b) -> a -> b
$ ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> l blk ValuesMK -> l blk DiffMK
forall (l :: StateKind) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> l blk ValuesMK -> l blk DiffMK
tickThenReapply ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
blk l blk ValuesMK
state)

{-------------------------------------------------------------------------------
  Short-hand
-------------------------------------------------------------------------------}

ledgerTipPoint ::
  UpdateLedger blk =>
  LedgerState blk mk -> Point blk
ledgerTipPoint :: forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> Point blk
ledgerTipPoint = Point (LedgerState blk) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState blk) -> Point blk)
-> (LedgerState blk mk -> Point (LedgerState blk))
-> LedgerState blk mk
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk mk -> Point (LedgerState blk)
forall (mk :: MapKind).
LedgerState blk mk -> Point (LedgerState blk)
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip

ledgerTipHash ::
  UpdateLedger blk =>
  LedgerState blk mk -> ChainHash blk
ledgerTipHash :: forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> ChainHash blk
ledgerTipHash = Point blk -> ChainHash blk
forall {k} (block :: k). Point block -> ChainHash block
pointHash (Point blk -> ChainHash blk)
-> (LedgerState blk mk -> Point blk)
-> LedgerState blk mk
-> ChainHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk mk -> Point blk
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> Point blk
ledgerTipPoint

ledgerTipSlot ::
  UpdateLedger blk =>
  LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot :: forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot = Point blk -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot (Point blk -> WithOrigin SlotNo)
-> (LedgerState blk mk -> Point blk)
-> LedgerState blk mk
-> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk mk -> Point blk
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> Point blk
ledgerTipPoint