Add totalCertsDepositsDPState. Add consumed:

Make `getConsumedValue` accept a deposit lookup function instead of a `DPState`

Introduce `consumed` that uses `getConsumedValue`

Add `lookupDepositDState` and `lookupRewardDState`

eras/mary/impl/src/Cardano/Ledger/Mary/UTxO.hs

@@ -6,13 +6,14 @@
 
 module Cardano.Ledger.Mary.UTxO (getConsumedMaryValue) where
 
-import Cardano.Ledger.Core
+import Cardano.Ledger.Coin (Coin)
+import Cardano.Ledger.Credential (StakeCredential)
 import Cardano.Ledger.Crypto
+import Cardano.Ledger.Mary.Core
 import Cardano.Ledger.Mary.Era (MaryEra)
-import Cardano.Ledger.Mary.TxBody (MaryEraTxBody (..))
+import Cardano.Ledger.Mary.TxBody ()
 import Cardano.Ledger.Mary.Value (MaryValue)
-import Cardano.Ledger.Shelley.LedgerState (DPState, keyTxRefunds)
-import Cardano.Ledger.Shelley.TxBody (Withdrawals (..))
+import Cardano.Ledger.Shelley.LedgerState (keyCertsRefunds)
 import Cardano.Ledger.Shelley.UTxO (
   ShelleyScriptsNeeded (..),
   getShelleyScriptsNeeded,
@@ -49,17 +50,17 @@ instance Crypto c => EraUTxO (MaryEra c) where
 getConsumedMaryValue ::
   (MaryEraTxBody era, Value era ~ MaryValue (EraCrypto era)) =>
   PParams era ->
-  DPState (EraCrypto era) ->
+  (StakeCredential (EraCrypto era) -> Maybe Coin) ->
   UTxO era ->
   TxBody era ->
   MaryValue (EraCrypto era)
-getConsumedMaryValue pp dpstate (UTxO u) txBody = consumedValue <> txBody ^. mintValueTxBodyF
+getConsumedMaryValue pp lookupRefund (UTxO u) txBody = consumedValue <> txBody ^. mintValueTxBodyF
   where
     {- balance (txins tx ◁ u) + wbalance (txwdrls tx) + keyRefunds pp tx -}
     consumedValue =
       balance (UTxO (Map.restrictKeys u (txBody ^. inputsTxBodyL)))
         <> inject (refunds <> withdrawals)
-    refunds = keyTxRefunds pp dpstate txBody
+    refunds = keyCertsRefunds pp lookupRefund (txBody ^. certsTxBodyG)
     withdrawals = fold . unWithdrawals $ txBody ^. withdrawalsTxBodyL
 
 -- | Computes the set of script hashes required to unlock the transaction inputs and the

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs

@@ -97,6 +97,7 @@ import Cardano.Ledger.Shelley.LedgerState (
   RewardUpdate,
   UTxOState (..),
   circulation,
+  consumed,
   createRUpd,
   incrementalStakeDistr,
   produced,
@@ -510,7 +511,7 @@ evaluateTransactionBalance ::
   -- | The difference between what the transaction consumes and what it produces.
   Value era
 evaluateTransactionBalance pp dpstate u txb =
-  getConsumedValue pp dpstate u txb <-> produced pp dpstate txb
+  consumed pp dpstate u txb <-> produced pp dpstate txb
 
 --------------------------------------------------------------------------------
 -- Shelley specifics

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs

@@ -47,9 +47,9 @@ module Cardano.Ledger.Shelley.LedgerState (
   nullWitHashes,
   diffWitHashes,
   minfee,
+  consumed,
   produced,
   witsFromTxWitnesses,
-
 
   -- * DelegationState
   keyTxRefunds,
@@ -58,6 +58,7 @@ module Cardano.Ledger.Shelley.LedgerState (
   totalTxDeposits,
   obligationDPState,
   keyCertsRefunds,
+  keyCertsRefundsDPState,
   totalCertsDeposits,
   totalCertsDepositsDPState,
 
@@ -109,7 +110,7 @@ import Cardano.Ledger.Shelley.PParams (
 import Cardano.Ledger.Shelley.RewardUpdate
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUPPredFailure, ShelleyPPUPState (..))
 import Cardano.Ledger.Shelley.Tx (minfee, witsFromTxWitnesses)
-import Cardano.Ledger.Shelley.UTxO (produced)
+import Cardano.Ledger.Shelley.UTxO (consumed, produced)
 import Data.Default.Class (def)
 import Data.Set (Set)
 import qualified Data.Set as Set

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/RefundsAndDeposits.hs

@@ -13,13 +13,14 @@ module Cardano.Ledger.Shelley.LedgerState.RefundsAndDeposits (
   totalCertsDepositsDPState,
   keyTxRefunds,
   keyCertsRefunds,
+  keyCertsRefundsDPState,
 )
 where
 
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (StakeCredential)
-import Cardano.Ledger.DPState (DPState (..), DState (..), PState (..))
+import Cardano.Ledger.DPState (DPState (..), PState (..), lookupDepositDState)
 import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
 import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..), isRegKey)
 import Cardano.Ledger.Shelley.TxBody (
@@ -29,12 +30,6 @@ import Cardano.Ledger.Shelley.TxBody (
   pattern RegKey,
   pattern RegPool,
  )
-import Cardano.Ledger.UMapCompact (
-  RDPair (..),
-  View (RewardDeposits),
-  fromCompact,
- )
-import qualified Cardano.Ledger.UMapCompact as UM
 import Cardano.Ledger.Val ((<+>), (<×>))
 import Data.Foldable (foldMap', foldl')
 import qualified Data.Map.Strict as Map
@@ -91,44 +86,38 @@ totalTxDeposits pp dpstate txb =
   totalCertsDepositsDPState pp dpstate (txb ^. certsTxBodyG)
 
 -- | Compute the key deregistration refunds in a transaction
-keyCertsRefunds ::
+keyCertsRefundsDPState ::
   (EraPParams era, Foldable f) =>
   PParams era ->
-  DPState c ->
-  f (DCert c) ->
+  DPState (EraCrypto era) ->
+  f (DCert (EraCrypto era)) ->
   Coin
-keyCertsRefunds pp dpstate = keyCertsRefunds' pp lookupDeposit
-  where
-    currentDeposits = RewardDeposits $ dsUnified $ dpsDState dpstate
-    lookupDeposit k = do
-      RDPair _ deposit <- UM.lookup k currentDeposits
-      Just $! fromCompact deposit
+keyCertsRefundsDPState pp dpstate = keyCertsRefunds pp (lookupDepositDState (dpsDState dpstate))
 
 -- | Compute the key deregistration refunds in a transaction
-keyCertsRefunds' ::
+keyCertsRefunds ::
   (EraPParams era, Foldable f) =>
   PParams era ->
   -- | Function that can lookup current deposit, in case when the stake key is registered.
-  (StakeCredential c -> Maybe Coin) ->
-  f (DCert c) ->
+  (StakeCredential (EraCrypto era) -> Maybe Coin) ->
+  f (DCert (EraCrypto era)) ->
   Coin
-keyCertsRefunds' pp lookupDeposit certs = snd (foldl' accum (mempty, Coin 0) certs)
+keyCertsRefunds pp lookupDeposit certs = snd (foldl' accum (mempty, Coin 0) certs)
   where
     keyDeposit = pp ^. ppKeyDepositL
     accum (!regKeys, !totalRefunds) = \case
       DCertDeleg (RegKey k) ->
-        -- Need to keep new delegations in case that the same key is later deregistered in
+        -- Need to track new delegations in case that the same key is later deregistered in
         -- the same transaction.
         (Set.insert k regKeys, totalRefunds)
       DCertDeleg (DeRegKey k)
         -- We first check if there was already a registration certificate in this
-        -- transaction, because the only way this state is valid is if it was preceeded by
-        -- a de-registration certifcate, which in turn could only be valid if either the
-        -- key wa already registered before this transaction or if the registration
-        -- for the same key preceeded it in this transaction.
+        -- transaction.
         | Set.member k regKeys -> (Set.delete k regKeys, totalRefunds <+> keyDeposit)
-        -- The last check is for the deposit left during registration in some previous
-        -- transaction
+        -- Check for the deposit left during registration in some previous
+        -- transaction. This de-registration check will be matched first, despite being
+        -- the last case to match, because registration is not possible without
+        -- de-registration.
         | Just deposit <- lookupDeposit k -> (regKeys, totalRefunds <+> deposit)
       _ -> (regKeys, totalRefunds)
 
@@ -138,4 +127,4 @@ keyTxRefunds ::
   DPState (EraCrypto era) ->
   TxBody era ->
   Coin
-keyTxRefunds pp dpstate tx = keyCertsRefunds pp dpstate (tx ^. certsTxBodyG)
+keyTxRefunds pp dpstate tx = keyCertsRefundsDPState pp dpstate (tx ^. certsTxBodyG)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs

@@ -83,10 +83,10 @@ import Cardano.Ledger.Shelley.TxBody (
   ShelleyEraTxBody (..),
   Withdrawals (..),
  )
-import Cardano.Ledger.Shelley.UTxO (produced, txup)
+import Cardano.Ledger.Shelley.UTxO (consumed, produced, txup)
 import Cardano.Ledger.Slot (SlotNo)
 import Cardano.Ledger.UTxO (
-  EraUTxO (getConsumedValue),
+  EraUTxO,
   UTxO (..),
   balance,
   txouts,
@@ -533,7 +533,7 @@ validateValueNotConservedUTxO pp utxo dpstate txb =
   failureUnless (consumedValue == producedValue) $
     (ValueNotConservedUTxO consumedValue producedValue)
   where
-    consumedValue = getConsumedValue pp dpstate utxo txb
+    consumedValue = consumed pp dpstate utxo txb
     producedValue = produced pp dpstate txb
 
 -- | Ensure there are no `TxOut`s that have less than @minUTxOValue@

eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs

@@ -22,6 +22,7 @@ module Cardano.Ledger.Shelley.UTxO (
   scriptCred,
   scriptStakeCred,
   getConsumedCoin,
+  consumed,
   produced,
   txup,
   module UTxO,
@@ -32,17 +33,17 @@ import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core
-import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.Credential (Credential (..), StakeCredential)
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.DPState (DPState (..), PState (..))
+import Cardano.Ledger.DPState (DPState (..), PState (..), lookupDepositDState)
 import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
 import Cardano.Ledger.Shelley.Delegation.Certificates (
   DCert (..),
   requiresVKeyWitness,
  )
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
 import Cardano.Ledger.Shelley.LedgerState.RefundsAndDeposits (
-  keyTxRefunds,
+  keyCertsRefunds,
   totalCertsDeposits,
  )
 import Cardano.Ledger.Shelley.PParams (Update)
@@ -125,6 +126,15 @@ getShelleyScriptsNeeded u txBody =
     scriptHashes = txinsScriptHashes (txBody ^. inputsTxBodyL) u
     certificates = toList (txBody ^. certsTxBodyG)
 
+consumed ::
+  EraUTxO era =>
+  PParams era ->
+  DPState (EraCrypto era) ->
+  UTxO era ->
+  TxBody era ->
+  Value era
+consumed pp dpstate = getConsumedValue pp (lookupDepositDState (dpsDState dpstate))
+
 -- | Compute the lovelace which are created by the transaction
 produced ::
   ShelleyEraTxBody era =>
@@ -151,17 +161,17 @@ getProducedValue pp isRegPoolId txBody =
 getConsumedCoin ::
   ShelleyEraTxBody era =>
   PParams era ->
-  DPState (EraCrypto era) ->
+  (StakeCredential (EraCrypto era) -> Maybe Coin) ->
   UTxO era ->
   TxBody era ->
   Coin
-getConsumedCoin pp dpstate (UTxO u) txBody =
+getConsumedCoin pp lookupRefund (UTxO u) txBody =
   {- balance (txins tx ◁ u) + wbalance (txwdrls tx) + keyRefunds dpstate tx -}
   coinBalance (UTxO (Map.restrictKeys u (txBody ^. inputsTxBodyL)))
     <> refunds
     <> withdrawals
   where
-    refunds = keyTxRefunds pp dpstate txBody
+    refunds = keyCertsRefunds pp lookupRefund (txBody ^. certsTxBodyG)
     withdrawals = fold . unWithdrawals $ txBody ^. withdrawalsTxBodyL
 
 newtype ShelleyScriptsNeeded era = ShelleyScriptsNeeded (Set.Set (ScriptHash (EraCrypto era)))

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/DCert.hs

@@ -30,7 +30,11 @@ import Cardano.Ledger.Shelley.API (
   ShelleyDELPL,
  )
 import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..))
-import Cardano.Ledger.Shelley.LedgerState (DPState (..), keyCertsRefunds, totalCertsDepositsDPState)
+import Cardano.Ledger.Shelley.LedgerState (
+  DPState (..),
+  keyCertsRefundsDPState,
+  totalCertsDepositsDPState,
+ )
 import Cardano.Ledger.Shelley.Rules (ShelleyDelplEvent, ShelleyDelplPredFailure)
 import Cardano.Ledger.Slot (SlotNo (..))
 import Control.Monad.Trans.Reader (runReaderT)
@@ -228,7 +232,7 @@ genDCerts
         (certs, creds) = unzip certsCreds
         (scriptCreds, keyCreds) = partition isScript creds
         keyCreds' = concat (keyCreds : map scriptWitnesses scriptCreds)
-        refunds = keyCertsRefunds pparams dpState certs
+        refunds = keyCertsRefundsDPState pparams dpState certs
     pure
       ( StrictSeq.fromList certs
       , totalCertsDepositsDPState pparams dpState certs

libs/cardano-ledger-core/CHANGELOG.md

@@ -19,6 +19,10 @@
   * `Reward` and `RewardType`
   * `AuxiliaryDataHash`
   * `Credential`
+* Make `getConsumedValue` accept a deposit lookup function instead of a `DPState`
+* Add `lookupDepositDState` and `lookupRewardDState`. Former can be used with
+  `getConsumedValue` to regain previous behavior.
+
 
 ## 1.0.0.0
 

libs/cardano-ledger-core/src/Cardano/Ledger/Compactible.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Ledger.Compactible (
   -- * Compactible

libs/cardano-ledger-core/src/Cardano/Ledger/DPState.hs

@@ -14,6 +14,8 @@
 module Cardano.Ledger.DPState (
   DPState (..),
   DState (..),
+  lookupDepositDState,
+  lookupRewardDState,
   PState (..),
   InstantaneousRewards (..),
   FutureGenDeleg (..),
@@ -43,8 +45,9 @@ import Cardano.Ledger.Coin (
   Coin (..),
   DeltaCoin (..),
  )
+import Cardano.Ledger.Compactible (fromCompact)
 import Cardano.Ledger.Core (EraCrypto, EraPParams, PParams, ppPoolDepositL)
-import Cardano.Ledger.Credential (Credential (..), Ptr)
+import Cardano.Ledger.Credential (Credential (..), Ptr, StakeCredential)
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
   GenDelegPair (..),
@@ -183,6 +186,20 @@ toDStatePair DState {..} =
   , "irwd" .= dsIRewards
   ]
 
+lookupDepositDState :: DState c -> (StakeCredential c -> Maybe Coin)
+lookupDepositDState dstate =
+  let currentRewardDeposits = RewardDeposits $ dsUnified dstate
+   in \k -> do
+        RDPair _ deposit <- UM.lookup k currentRewardDeposits
+        Just $! fromCompact deposit
+
+lookupRewardDState :: DState c -> (StakeCredential c -> Maybe Coin)
+lookupRewardDState dstate =
+  let currentRewardDeposits = RewardDeposits $ dsUnified dstate
+   in \k -> do
+        RDPair reward _ <- UM.lookup k currentRewardDeposits
+        Just $! fromCompact reward
+
 -- | The state used by the POOL rule, which tracks stake pool information.
 data PState c = PState
   { psStakePoolParams :: !(Map (KeyHash 'StakePool c) (PoolParams c))

libs/cardano-ledger-core/src/Cardano/Ledger/UTxO.hs

@@ -47,9 +47,8 @@ import Cardano.Ledger.Block (txid)
 import Cardano.Ledger.Coin (Coin, CompactForm (CompactCoin))
 import Cardano.Ledger.Compactible (Compactible (..))
 import Cardano.Ledger.Core
-import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.Credential (Credential (..), StakeCredential)
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.DPState (DPState)
 import Cardano.Ledger.Keys (
   DSignable,
   Hash,
@@ -204,7 +203,13 @@ class EraTxBody era => EraUTxO era where
   type ScriptsNeeded era = (r :: Type) | r -> era
 
   -- | Calculate all the value that is being consumed by the transaction.
-  getConsumedValue :: PParams era -> DPState (EraCrypto era) -> UTxO era -> TxBody era -> Value era
+  getConsumedValue ::
+    PParams era ->
+    -- | Function that can lookup current delegation deposits
+    (StakeCredential (EraCrypto era) -> Maybe Coin) ->
+    UTxO era ->
+    TxBody era ->
+    Value era
 
   -- | Produce all the information required for figuring out which scripts are required
   -- for the transaction to be valid, once those scripts are evaluated