{-# LANGUAGE FlexibleContexts #-}

-- | A collection of useful combinators to shorten the code in other places.
--
-- This whole module provides ways to combine tables of two ledger states to
-- produce another one. It is written very much ad-hoc and we should probably
-- think of some way to make this more ergonomic. In particular for functions
-- that take two ledger states, it is unclear if it will keep the in-memory part
-- of the first or the second one.
module Ouroboros.Consensus.Ledger.Tables.Utils
  ( -- * Projection and injection
    ltprj
  , ltwith

    -- * Basic operations
  , emptyLedgerTables
  , forgetLedgerTables

    -- * Operations on 'DiffMK'

    -- ** Apply diffs
  , applyDiffForKeys
  , applyDiffForKeysOnTables
  , applyDiffs

    -- ** Create diffs
  , calculateDifference
  , noNewTickingDiffs
  , valuesAsDiffs

    -- ** Combining diffs
  , prependDiffs
  , rawPrependDiffs

    -- * Operations on 'TrackingMK'

    -- ** Augment
  , attachAndApplyDiffs
  , attachEmptyDiffs
  , prependTrackingDiffs

    -- ** Reduce
  , trackingToDiffs
  , rawTrackingDiffs
  , trackingToValues

    -- * Union values
  , unionValues

    -- * Exposed for @cardano-api@
  , applyDiffsMK
  , restrictValuesMK

    -- * Testing
  , applyDiffs'
  , rawAttachAndApplyDiffs -- used in test
  , rawCalculateDifference -- used in test
  ) where

import qualified Data.Map.Strict as Map
import Ouroboros.Consensus.Ledger.Tables
import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff

{-------------------------------------------------------------------------------
  Projection and injection
-------------------------------------------------------------------------------}

ltwith ::
  ( HasLedgerTables l blk
  , CanMapMK mk'
  , CanMapKeysMK mk'
  , ZeroableMK mk'
  ) =>
  l blk mk ->
  LedgerTables blk mk' ->
  l blk mk'
ltwith :: forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith = l blk mk -> LedgerTables blk mk' -> l blk mk'
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
forall (l :: StateKind) blk (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
withLedgerTables

ltprj ::
  (HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
  l blk mk ->
  LedgerTables blk mk
ltprj :: forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj = l blk mk -> LedgerTables blk mk
forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
projectLedgerTables

{-------------------------------------------------------------------------------
  Utils aliases: tables
-------------------------------------------------------------------------------}

-- | Replace tables with an empty diff. Can be used to specify that a ledger
-- state tick produces no new UTXO entries.
noNewTickingDiffs ::
  HasLedgerTables l blk =>
  l blk any ->
  l blk DiffMK
noNewTickingDiffs :: forall (l :: StateKind) blk (any :: MapKind).
HasLedgerTables l blk =>
l blk any -> l blk DiffMK
noNewTickingDiffs l blk any
l = l blk any -> LedgerTables blk DiffMK -> l blk DiffMK
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
forall (l :: StateKind) blk (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
withLedgerTables l blk any
l LedgerTables blk DiffMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

-- | Remove the ledger tables
forgetLedgerTables :: HasLedgerTables l blk => l blk mk -> l blk EmptyMK
forgetLedgerTables :: forall (l :: StateKind) blk (mk :: MapKind).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables l blk mk
l = l blk mk -> LedgerTables blk EmptyMK -> l blk EmptyMK
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
forall (l :: StateKind) blk (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
withLedgerTables l blk mk
l LedgerTables blk EmptyMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

-- | Empty values for every table
emptyLedgerTables :: (ZeroableMK mk, LedgerTableConstraints blk) => LedgerTables blk mk
emptyLedgerTables :: forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables = (forall k v. LedgerTableConstraints' blk k v => mk k v)
-> LedgerTables blk mk
forall l (mk :: MapKind).
LedgerTableConstraints l =>
(forall k v. LedgerTableConstraints' blk k v => mk k v)
-> LedgerTables l mk
ltpure mk k v
forall k v. (Ord k, Eq v) => mk k v
forall k v. LedgerTableConstraints' blk k v => mk k v
forall (mk :: MapKind) k v. (ZeroableMK mk, Ord k, Eq v) => mk k v
emptyMK

--
-- Forget parts of 'TrackingMK'
--

rawTrackingDiffs :: TrackingMK k v -> DiffMK k v
rawTrackingDiffs :: forall k v. TrackingMK k v -> DiffMK k v
rawTrackingDiffs (TrackingMK Map k v
_vs Diff k v
d) = Diff k v -> DiffMK k v
forall k v. Diff k v -> DiffMK k v
DiffMK Diff k v
d

trackingToDiffs :: HasLedgerTables l blk => l blk TrackingMK -> l blk DiffMK
trackingToDiffs :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
l blk TrackingMK -> l blk DiffMK
trackingToDiffs l blk TrackingMK
l = l blk TrackingMK -> LedgerTables blk DiffMK -> l blk DiffMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l blk TrackingMK
l (LedgerTables blk DiffMK -> l blk DiffMK)
-> LedgerTables blk DiffMK -> l blk DiffMK
forall a b. (a -> b) -> a -> b
$ (forall k v.
 LedgerTableConstraints' blk k v =>
 TrackingMK k v -> DiffMK k v)
-> LedgerTables blk TrackingMK -> LedgerTables blk DiffMK
forall l (mk1 :: MapKind) (mk2 :: MapKind).
LedgerTableConstraints l =>
(forall k v. LedgerTableConstraints' blk k v => mk1 k v -> mk2 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2
ltmap TrackingMK k v -> DiffMK k v
forall k v.
LedgerTableConstraints' blk k v =>
TrackingMK k v -> DiffMK k v
forall k v. TrackingMK k v -> DiffMK k v
rawTrackingDiffs (l blk TrackingMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk TrackingMK
l)

--
-- Forget diffs
--

rawTrackingValues :: TrackingMK k v -> ValuesMK k v
rawTrackingValues :: forall k v. TrackingMK k v -> ValuesMK k v
rawTrackingValues (TrackingMK Map k v
vs Diff k v
_ds) = Map k v -> ValuesMK k v
forall k v. Map k v -> ValuesMK k v
ValuesMK Map k v
vs

trackingToValues :: HasLedgerTables l blk => l blk TrackingMK -> l blk ValuesMK
trackingToValues :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
l blk TrackingMK -> l blk ValuesMK
trackingToValues l blk TrackingMK
l = l blk TrackingMK -> LedgerTables blk ValuesMK -> l blk ValuesMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l blk TrackingMK
l (LedgerTables blk ValuesMK -> l blk ValuesMK)
-> LedgerTables blk ValuesMK -> l blk ValuesMK
forall a b. (a -> b) -> a -> b
$ (forall k v.
 LedgerTableConstraints' blk k v =>
 TrackingMK k v -> ValuesMK k v)
-> LedgerTables blk TrackingMK -> LedgerTables blk ValuesMK
forall l (mk1 :: MapKind) (mk2 :: MapKind).
LedgerTableConstraints l =>
(forall k v. LedgerTableConstraints' blk k v => mk1 k v -> mk2 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2
ltmap TrackingMK k v -> ValuesMK k v
forall k v.
LedgerTableConstraints' blk k v =>
TrackingMK k v -> ValuesMK k v
forall k v. TrackingMK k v -> ValuesMK k v
rawTrackingValues (l blk TrackingMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk TrackingMK
l)

--
-- Prepend diffs
--

rawPrependDiffs ::
  Ord k =>
  -- | Earlier differences
  DiffMK k v ->
  -- | Later differences
  DiffMK k v ->
  DiffMK k v
rawPrependDiffs :: forall k v. Ord k => DiffMK k v -> DiffMK k v -> DiffMK k v
rawPrependDiffs (DiffMK Diff k v
d1) (DiffMK Diff k v
d2) = Diff k v -> DiffMK k v
forall k v. Diff k v -> DiffMK k v
DiffMK (Diff k v
d1 Diff k v -> Diff k v -> Diff k v
forall a. Semigroup a => a -> a -> a
<> Diff k v
d2)

-- | Prepend diffs from the first ledger state to the diffs from the second
-- ledger state. Returns ledger tables.
prependDiffs' ::
  ( HasLedgerTables l blk
  , HasLedgerTables l' blk
  ) =>
  l blk DiffMK -> l' blk DiffMK -> LedgerTables blk DiffMK
prependDiffs' :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk DiffMK -> l' blk DiffMK -> LedgerTables blk DiffMK
prependDiffs' l blk DiffMK
l1 l' blk DiffMK
l2 = (forall k v.
 LedgerTableConstraints' blk k v =>
 DiffMK k v -> DiffMK k v -> DiffMK k v)
-> LedgerTables blk DiffMK
-> LedgerTables blk DiffMK
-> LedgerTables blk DiffMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 DiffMK k v -> DiffMK k v -> DiffMK k v
forall k v. Ord k => DiffMK k v -> DiffMK k v -> DiffMK k v
forall k v.
LedgerTableConstraints' blk k v =>
DiffMK k v -> DiffMK k v -> DiffMK k v
rawPrependDiffs (l blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk DiffMK
l1) (l' blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l' blk DiffMK
l2)

-- | Prepend the diffs from @l1@ to @l2@. Returns @l2@.
prependDiffs ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk DiffMK -> l' blk DiffMK -> l' blk DiffMK
prependDiffs :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk DiffMK -> l' blk DiffMK -> l' blk DiffMK
prependDiffs l blk DiffMK
l1 l' blk DiffMK
l2 = l' blk DiffMK -> LedgerTables blk DiffMK -> l' blk DiffMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk DiffMK
l2 (LedgerTables blk DiffMK -> l' blk DiffMK)
-> LedgerTables blk DiffMK -> l' blk DiffMK
forall a b. (a -> b) -> a -> b
$ l blk DiffMK -> l' blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk DiffMK -> l' blk DiffMK -> LedgerTables blk DiffMK
prependDiffs' l blk DiffMK
l1 l' blk DiffMK
l2

--
-- Apply diffs
--

applyDiffsMK ::
  Ord k =>
  -- | Values to which differences are applied
  ValuesMK k v ->
  -- | Differences to apply
  DiffMK k v ->
  ValuesMK k v
applyDiffsMK :: forall k v. Ord k => ValuesMK k v -> DiffMK k v -> ValuesMK k v
applyDiffsMK (ValuesMK Map k v
vals) (DiffMK Diff k v
diffs) = Map k v -> ValuesMK k v
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map k v -> Diff k v -> Map k v
forall k v. Ord k => Map k v -> Diff k v -> Map k v
Diff.applyDiff Map k v
vals Diff k v
diffs)

-- | Apply diffs from the second ledger state to the values of the first ledger
-- state. Returns ledger tables.
applyDiffs' ::
  ( HasLedgerTables l blk
  , HasLedgerTables l' blk
  ) =>
  l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk ValuesMK
applyDiffs' :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk ValuesMK
applyDiffs' l blk ValuesMK
l1 l' blk DiffMK
l2 = (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> DiffMK k v -> ValuesMK k v)
-> LedgerTables blk ValuesMK
-> LedgerTables blk DiffMK
-> LedgerTables blk ValuesMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 ValuesMK k v -> DiffMK k v -> ValuesMK k v
forall k v. Ord k => ValuesMK k v -> DiffMK k v -> ValuesMK k v
forall k v.
LedgerTableConstraints' blk k v =>
ValuesMK k v -> DiffMK k v -> ValuesMK k v
applyDiffsMK (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l1) (l' blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l' blk DiffMK
l2)

-- | Apply diffs from @l2@ on values from @l1@. Returns @l2@.
applyDiffs ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk ValuesMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffs :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffs l blk ValuesMK
l1 l' blk DiffMK
l2 = l' blk DiffMK -> LedgerTables blk ValuesMK -> l' blk ValuesMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk DiffMK
l2 (LedgerTables blk ValuesMK -> l' blk ValuesMK)
-> LedgerTables blk ValuesMK -> l' blk ValuesMK
forall a b. (a -> b) -> a -> b
$ l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk ValuesMK
applyDiffs' l blk ValuesMK
l1 l' blk DiffMK
l2

rawApplyDiffForKeys ::
  Ord k =>
  ValuesMK k v ->
  KeysMK k v ->
  DiffMK k v ->
  ValuesMK k v
rawApplyDiffForKeys :: forall k v.
Ord k =>
ValuesMK k v -> KeysMK k v -> DiffMK k v -> ValuesMK k v
rawApplyDiffForKeys (ValuesMK Map k v
vals) (KeysMK Set k
keys) (DiffMK Diff k v
diffs) =
  Map k v -> ValuesMK k v
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map k v -> Set k -> Diff k v -> Map k v
forall k v. Ord k => Map k v -> Set k -> Diff k v -> Map k v
Diff.applyDiffForKeys Map k v
vals Set k
keys Diff k v
diffs)

-- | Apply diffs in @l3@ for keys in @l2@ and @l1@ on values from @l1@. Returns @l3@.
applyDiffForKeys ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk ValuesMK -> LedgerTables blk KeysMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffForKeys :: 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
l1 LedgerTables blk KeysMK
l2 l' blk DiffMK
l3 = l' blk DiffMK -> LedgerTables blk ValuesMK -> l' blk ValuesMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk DiffMK
l3 (LedgerTables blk ValuesMK -> l' blk ValuesMK)
-> LedgerTables blk ValuesMK -> l' blk ValuesMK
forall a b. (a -> b) -> a -> b
$ LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> l' blk DiffMK
-> LedgerTables blk ValuesMK
forall (l :: StateKind) blk.
HasLedgerTables l blk =>
LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> l blk DiffMK
-> LedgerTables blk ValuesMK
applyDiffForKeys' (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l1) LedgerTables blk KeysMK
l2 l' blk DiffMK
l3

applyDiffForKeys' ::
  HasLedgerTables l blk =>
  LedgerTables blk ValuesMK -> LedgerTables blk KeysMK -> l blk DiffMK -> LedgerTables blk ValuesMK
applyDiffForKeys' :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> l blk DiffMK
-> LedgerTables blk ValuesMK
applyDiffForKeys' LedgerTables blk ValuesMK
l1 LedgerTables blk KeysMK
l2 l blk DiffMK
l3 = (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> KeysMK k v -> DiffMK k v -> ValuesMK k v)
-> LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> LedgerTables blk DiffMK
-> LedgerTables blk ValuesMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind)
       (mk4 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v -> mk4 k v)
-> LedgerTables l mk1
-> LedgerTables l mk2
-> LedgerTables l mk3
-> LedgerTables l mk4
ltliftA3 ValuesMK k v -> KeysMK k v -> DiffMK k v -> ValuesMK k v
forall k v.
Ord k =>
ValuesMK k v -> KeysMK k v -> DiffMK k v -> ValuesMK k v
forall k v.
LedgerTableConstraints' blk k v =>
ValuesMK k v -> KeysMK k v -> DiffMK k v -> ValuesMK k v
rawApplyDiffForKeys LedgerTables blk ValuesMK
l1 LedgerTables blk KeysMK
l2 (l blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk DiffMK
l3)

-- | Apply diffs in @l3@ for keys in @l2@ and @l1@ on values from @l1@. Returns @l3@.
applyDiffForKeysOnTables ::
  HasLedgerTables l blk =>
  LedgerTables blk ValuesMK -> LedgerTables blk KeysMK -> l blk DiffMK -> l blk ValuesMK
applyDiffForKeysOnTables :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK -> l blk DiffMK -> l blk ValuesMK
applyDiffForKeysOnTables LedgerTables blk ValuesMK
l1 LedgerTables blk KeysMK
l2 l blk DiffMK
l3 = l blk DiffMK -> LedgerTables blk ValuesMK -> l blk ValuesMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l blk DiffMK
l3 (LedgerTables blk ValuesMK -> l blk ValuesMK)
-> LedgerTables blk ValuesMK -> l blk ValuesMK
forall a b. (a -> b) -> a -> b
$ LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> l blk DiffMK
-> LedgerTables blk ValuesMK
forall (l :: StateKind) blk.
HasLedgerTables l blk =>
LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> l blk DiffMK
-> LedgerTables blk ValuesMK
applyDiffForKeys' LedgerTables blk ValuesMK
l1 LedgerTables blk KeysMK
l2 l blk DiffMK
l3

--
-- Calculate differences
--

rawCalculateDifference ::
  (Ord k, Eq v) =>
  ValuesMK k v ->
  ValuesMK k v ->
  TrackingMK k v
rawCalculateDifference :: forall k v.
(Ord k, Eq v) =>
ValuesMK k v -> ValuesMK k v -> TrackingMK k v
rawCalculateDifference (ValuesMK Map k v
before) (ValuesMK Map k v
after) = Map k v -> Diff k v -> TrackingMK k v
forall k v. Map k v -> Diff k v -> TrackingMK k v
TrackingMK Map k v
after (Map k v -> Map k v -> Diff k v
forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Diff k v
Diff.diff Map k v
before Map k v
after)

-- | Promote values to diffs, for cases in which all existing values must be
-- considered diffs. In particular this is used when populating the ledger
-- tables for the first time.
valuesAsDiffs :: HasLedgerTables l blk => l blk ValuesMK -> l blk DiffMK
valuesAsDiffs :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
l blk ValuesMK -> l blk DiffMK
valuesAsDiffs l blk ValuesMK
l = l blk TrackingMK -> l blk DiffMK
forall (l :: StateKind) blk.
HasLedgerTables l blk =>
l blk TrackingMK -> l blk DiffMK
trackingToDiffs (l blk TrackingMK -> l blk DiffMK)
-> l blk TrackingMK -> l blk DiffMK
forall a b. (a -> b) -> a -> b
$ l blk ValuesMK -> LedgerTables blk TrackingMK -> l blk TrackingMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l blk ValuesMK
l (LedgerTables blk TrackingMK -> l blk TrackingMK)
-> LedgerTables blk TrackingMK -> l blk TrackingMK
forall a b. (a -> b) -> a -> b
$ (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> TrackingMK k v)
-> LedgerTables blk ValuesMK -> LedgerTables blk TrackingMK
forall l (mk1 :: MapKind) (mk2 :: MapKind).
LedgerTableConstraints l =>
(forall k v. LedgerTableConstraints' blk k v => mk1 k v -> mk2 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2
ltliftA (ValuesMK k v -> ValuesMK k v -> TrackingMK k v
forall k v.
(Ord k, Eq v) =>
ValuesMK k v -> ValuesMK k v -> TrackingMK k v
rawCalculateDifference ValuesMK k v
forall k v. (Ord k, Eq v) => ValuesMK k v
forall (mk :: MapKind) k v. (ZeroableMK mk, Ord k, Eq v) => mk k v
emptyMK) (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l)

-- | Calculate the differences between two ledger states. The first ledger state
-- is considered /before/, the second ledger state is considered /after/.
-- Returns ledger tables.
calculateDifference' ::
  ( HasLedgerTables l blk
  , HasLedgerTables l' blk
  ) =>
  l blk ValuesMK -> l' blk ValuesMK -> LedgerTables blk TrackingMK
calculateDifference' :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk ValuesMK -> LedgerTables blk TrackingMK
calculateDifference' l blk ValuesMK
l1 l' blk ValuesMK
l2 = (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> ValuesMK k v -> TrackingMK k v)
-> LedgerTables blk ValuesMK
-> LedgerTables blk ValuesMK
-> LedgerTables blk TrackingMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 ValuesMK k v -> ValuesMK k v -> TrackingMK k v
forall k v.
(Ord k, Eq v) =>
ValuesMK k v -> ValuesMK k v -> TrackingMK k v
forall k v.
LedgerTableConstraints' blk k v =>
ValuesMK k v -> ValuesMK k v -> TrackingMK k v
rawCalculateDifference (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l1) (l' blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l' blk ValuesMK
l2)

-- | Calculate the differences between two ledger states. The first ledger state
-- is considered /before/, the second ledger state is considered /after/.
-- Returns the second ledger state.
calculateDifference ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk ValuesMK -> l' blk ValuesMK -> l' blk TrackingMK
calculateDifference :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk ValuesMK -> l' blk TrackingMK
calculateDifference l blk ValuesMK
l1 l' blk ValuesMK
l2 = l' blk ValuesMK -> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk ValuesMK
l2 (LedgerTables blk TrackingMK -> l' blk TrackingMK)
-> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall a b. (a -> b) -> a -> b
$ l blk ValuesMK -> l' blk ValuesMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk ValuesMK -> LedgerTables blk TrackingMK
calculateDifference' l blk ValuesMK
l1 l' blk ValuesMK
l2

--
-- Attaching and/or applying diffs
--

rawAttachAndApplyDiffs ::
  Ord k =>
  ValuesMK k v ->
  DiffMK k v ->
  TrackingMK k v
rawAttachAndApplyDiffs :: forall k v. Ord k => ValuesMK k v -> DiffMK k v -> TrackingMK k v
rawAttachAndApplyDiffs (ValuesMK Map k v
v) (DiffMK Diff k v
d) = Map k v -> Diff k v -> TrackingMK k v
forall k v. Map k v -> Diff k v -> TrackingMK k v
TrackingMK (Map k v -> Diff k v -> Map k v
forall k v. Ord k => Map k v -> Diff k v -> Map k v
Diff.applyDiff Map k v
v Diff k v
d) Diff k v
d

-- | Apply the differences from the first ledger state to the values of the
-- second ledger state, and returns the resulting values together with the
-- applied diff.
attachAndApplyDiffs' ::
  ( HasLedgerTables l blk
  , HasLedgerTables l' blk
  ) =>
  l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk TrackingMK
attachAndApplyDiffs' :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk TrackingMK
attachAndApplyDiffs' l blk ValuesMK
l1 l' blk DiffMK
l2 = (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> DiffMK k v -> TrackingMK k v)
-> LedgerTables blk ValuesMK
-> LedgerTables blk DiffMK
-> LedgerTables blk TrackingMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 ValuesMK k v -> DiffMK k v -> TrackingMK k v
forall k v. Ord k => ValuesMK k v -> DiffMK k v -> TrackingMK k v
forall k v.
LedgerTableConstraints' blk k v =>
ValuesMK k v -> DiffMK k v -> TrackingMK k v
rawAttachAndApplyDiffs (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l1) (l' blk DiffMK -> LedgerTables blk DiffMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l' blk DiffMK
l2)

-- | Apply the differences from the first ledger state to the values of the
-- second ledger state. Returns the second ledger state with a 'TrackingMK' of
-- the final values and all the diffs.
attachAndApplyDiffs ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk ValuesMK -> l' blk DiffMK -> l' blk TrackingMK
attachAndApplyDiffs :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> l' blk TrackingMK
attachAndApplyDiffs l blk ValuesMK
l1 l' blk DiffMK
l2 = l' blk DiffMK -> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk DiffMK
l2 (LedgerTables blk TrackingMK -> l' blk TrackingMK)
-> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall a b. (a -> b) -> a -> b
$ l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> LedgerTables blk TrackingMK
attachAndApplyDiffs' l blk ValuesMK
l1 l' blk DiffMK
l2

rawAttachEmptyDiffs :: Ord k => ValuesMK k v -> TrackingMK k v
rawAttachEmptyDiffs :: forall k v. Ord k => ValuesMK k v -> TrackingMK k v
rawAttachEmptyDiffs (ValuesMK Map k v
v) = Map k v -> Diff k v -> TrackingMK k v
forall k v. Map k v -> Diff k v -> TrackingMK k v
TrackingMK Map k v
v Diff k v
forall a. Monoid a => a
mempty

-- | Make a 'TrackingMK' with empty diffs.
attachEmptyDiffs :: HasLedgerTables l blk => l blk ValuesMK -> l blk TrackingMK
attachEmptyDiffs :: forall (l :: StateKind) blk.
HasLedgerTables l blk =>
l blk ValuesMK -> l blk TrackingMK
attachEmptyDiffs l blk ValuesMK
l1 = l blk ValuesMK -> LedgerTables blk TrackingMK -> l blk TrackingMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l blk ValuesMK
l1 (LedgerTables blk TrackingMK -> l blk TrackingMK)
-> LedgerTables blk TrackingMK -> l blk TrackingMK
forall a b. (a -> b) -> a -> b
$ (forall k v.
 LedgerTableConstraints' blk k v =>
 ValuesMK k v -> TrackingMK k v)
-> LedgerTables blk ValuesMK -> LedgerTables blk TrackingMK
forall l (mk1 :: MapKind) (mk2 :: MapKind).
LedgerTableConstraints l =>
(forall k v. LedgerTableConstraints' blk k v => mk1 k v -> mk2 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2
ltmap ValuesMK k v -> TrackingMK k v
forall k v. Ord k => ValuesMK k v -> TrackingMK k v
forall k v.
LedgerTableConstraints' blk k v =>
ValuesMK k v -> TrackingMK k v
rawAttachEmptyDiffs (l blk ValuesMK -> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk ValuesMK
l1)

--
-- Prepend tracking diffs
--

-- | Prepend the former tracking diffs to the latter tracking diffs. Keep the
-- second tracking values.
--
-- PRECONDITION: Given that the first argument is @TrackingMK v1 d1@, and the
-- second argument is @TrackingMK v2 d2@, it should be the case that @applyDiff
-- v1 d2 == v2@.
rawPrependTrackingDiffs ::
  Ord k =>
  TrackingMK k v ->
  TrackingMK k v ->
  TrackingMK k v
rawPrependTrackingDiffs :: forall k v.
Ord k =>
TrackingMK k v -> TrackingMK k v -> TrackingMK k v
rawPrependTrackingDiffs (TrackingMK Map k v
_ Diff k v
d1) (TrackingMK Map k v
v Diff k v
d2) =
  Map k v -> Diff k v -> TrackingMK k v
forall k v. Map k v -> Diff k v -> TrackingMK k v
TrackingMK Map k v
v (Diff k v
d1 Diff k v -> Diff k v -> Diff k v
forall a. Semigroup a => a -> a -> a
<> Diff k v
d2)

-- | Prepend tracking diffs from the first ledger state to the tracking diffs
-- from the second ledger state. Keep the tracking values of the second ledger
-- state.
--
-- PRECONDITION:  See 'rawPrependTrackingDiffs'.
prependTrackingDiffs' ::
  ( HasLedgerTables l blk
  , HasLedgerTables l' blk
  ) =>
  l blk TrackingMK -> l' blk TrackingMK -> LedgerTables blk TrackingMK
prependTrackingDiffs' :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk TrackingMK
-> l' blk TrackingMK -> LedgerTables blk TrackingMK
prependTrackingDiffs' l blk TrackingMK
l1 l' blk TrackingMK
l2 = (forall k v.
 LedgerTableConstraints' blk k v =>
 TrackingMK k v -> TrackingMK k v -> TrackingMK k v)
-> LedgerTables blk TrackingMK
-> LedgerTables blk TrackingMK
-> LedgerTables blk TrackingMK
forall l (mk1 :: MapKind) (mk2 :: MapKind) (mk3 :: MapKind).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' blk k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 TrackingMK k v -> TrackingMK k v -> TrackingMK k v
forall k v.
Ord k =>
TrackingMK k v -> TrackingMK k v -> TrackingMK k v
forall k v.
LedgerTableConstraints' blk k v =>
TrackingMK k v -> TrackingMK k v -> TrackingMK k v
rawPrependTrackingDiffs (l blk TrackingMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l blk TrackingMK
l1) (l' blk TrackingMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
ltprj l' blk TrackingMK
l2)

-- | Prepend tracking diffs from the first ledger state to the tracking diffs
-- from the second ledger state. Keep the tracking values of the second ledger
-- state. Returns the second ledger state.
--
-- PRECONDITION:  See 'rawPrependTrackingDiffs'.
prependTrackingDiffs ::
  (HasLedgerTables l blk, HasLedgerTables l' blk) =>
  l blk TrackingMK -> l' blk TrackingMK -> l' blk TrackingMK
prependTrackingDiffs :: forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk TrackingMK -> l' blk TrackingMK -> l' blk TrackingMK
prependTrackingDiffs l blk TrackingMK
l1 l' blk TrackingMK
l2 = l' blk TrackingMK
-> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall (l :: StateKind) blk (mk' :: MapKind) (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk', CanMapKeysMK mk',
 ZeroableMK mk') =>
l blk mk -> LedgerTables blk mk' -> l blk mk'
ltwith l' blk TrackingMK
l2 (LedgerTables blk TrackingMK -> l' blk TrackingMK)
-> LedgerTables blk TrackingMK -> l' blk TrackingMK
forall a b. (a -> b) -> a -> b
$ l blk TrackingMK
-> l' blk TrackingMK -> LedgerTables blk TrackingMK
forall (l :: StateKind) blk (l' :: StateKind).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk TrackingMK
-> l' blk TrackingMK -> LedgerTables blk TrackingMK
prependTrackingDiffs' l blk TrackingMK
l1 l' blk TrackingMK
l2

-- Restrict values

restrictValuesMK ::
  Ord k =>
  ValuesMK k v ->
  KeysMK k v ->
  ValuesMK k v
restrictValuesMK :: forall k v. Ord k => ValuesMK k v -> KeysMK k v -> ValuesMK k v
restrictValuesMK (ValuesMK Map k v
v) (KeysMK Set k
k) = Map k v -> ValuesMK k v
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map k v -> ValuesMK k v) -> Map k v -> ValuesMK k v
forall a b. (a -> b) -> a -> b
$ Map k v
v Map k v -> Set k -> Map k v
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set k
k

---

-- | For this first UTxO-HD iteration, there can't be two keys with
-- different values on the tables, thus there will never be
-- conflicting collisions.
unionValues ::
  Ord k =>
  ValuesMK k v ->
  ValuesMK k v ->
  ValuesMK k v
unionValues :: forall k v. Ord k => ValuesMK k v -> ValuesMK k v -> ValuesMK k v
unionValues (ValuesMK Map k v
m1) (ValuesMK Map k v
m2) = Map k v -> ValuesMK k v
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map k v -> ValuesMK k v) -> Map k v -> ValuesMK k v
forall a b. (a -> b) -> a -> b
$ Map k v -> Map k v -> Map k v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k v
m1 Map k v
m2