Change totalCertsDeposits and add getProducedValue

This change is needed to minimize the amount of require data for
computing the `evaluateTransactionBalance`

`totalCertsDepositsDPState` can be used to recover the previous behavior
of `totalCertsDeposits`.

eras/shelley/impl/CHANGELOG.md

@@ -28,6 +28,9 @@
   * `Likelihood` and `NonMyopic`
   * `RewardUpdate` and `PulsingRewUpdate`
 * Added of `ToJSON`/`FromJSON` instances for `LogWeight`
+* Change `totalCertsDeposits` to accept a function that checks for registered pools,
+  rather than the `DPState`. Use `totalCertsDepositsDPState` for the previous behavior
+* Added `getProducedValue` and `totalCertsDepositsDPState`.
 
 ### `testlib`
 

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

@@ -76,8 +76,9 @@ totalAdaPotsES (EpochState (AccountState treasury_ reserves_) _ ls _ _ _) =
     DPState dstate _ = lsDPState ls
     rewards_ = fromCompact $ sumRewardsView (rewards dstate)
     coins = coinBalance u
-    keyDeposits_ = (fromCompact . sumDepositView . RewardDeposits . dsUnified . dpsDState . lsDPState) ls
-    poolDeposits_ = fold ((psDeposits . dpsPState . lsDPState) ls)
+    keyDeposits_ =
+      fromCompact . sumDepositView . RewardDeposits . dsUnified . dpsDState $ lsDPState ls
+    poolDeposits_ = fold (psDeposits . dpsPState $ lsDPState ls)
 
 -- | Calculate the total ada in the epoch state
 totalAdaES :: EraTxOut era => EpochState era -> Coin
@@ -94,10 +95,10 @@ totalAdaES cs =
       , reservesAdaPot
       , rewardsAdaPot
       , utxoAdaPot
-      , -- keyDepositAdaPot,  -- We don't count these two, as their
-      -- poolDepositAdaPot, -- sum is always depositsAdaPot
-      depositsAdaPot
+      , depositsAdaPot
       , feesAdaPot
+      -- , keyDepositAdaPot  -- We don't count these two, as their
+      -- , poolDepositAdaPot -- sum is always depositsAdaPot
       } = totalAdaPotsES cs
 
 -- =============================================
@@ -110,15 +111,32 @@ data Consumed = Consumed
 
 instance Show Consumed where
   show (Consumed (Coin i) (Coin r) (Coin w)) =
-    "Consumed(Inputs " ++ show i ++ ", Refunds " ++ show r ++ ", Withdrawals " ++ show w ++ ") = " ++ show (i + r + w)
+    "Consumed(Inputs "
+      ++ show i
+      ++ ", Refunds "
+      ++ show r
+      ++ ", Withdrawals "
+      ++ show w
+      ++ ") = "
+      ++ show (i + r + w)
 
 -- | Itemizing what is Produced by a transaction
 data Produced = Produced
-  {proOutputs :: !Coin, proFees :: !Coin, proDeposits :: !Coin}
+  { proOutputs :: !Coin
+  , proFees :: !Coin
+  , proDeposits :: !Coin
+  }
 
 instance Show Produced where
   show (Produced (Coin out) (Coin f) (Coin d)) =
-    "Produced(Outputs " ++ show out ++ ", Fees " ++ show f ++ ", Deposits " ++ show d ++ ") = " ++ show (out + f + d)
+    "Produced(Outputs "
+      ++ show out
+      ++ ", Fees "
+      ++ show f
+      ++ ", Deposits "
+      ++ show d
+      ++ ") = "
+      ++ show (out + f + d)
 
 -- =========================
 
@@ -130,11 +148,12 @@ consumedTxBody ::
   DPState (EraCrypto era) ->
   UTxO era ->
   Consumed
-consumedTxBody txBody pp dpstate (UTxO u) = Consumed {conInputs = i, conRefunds = r, conWithdrawals = w}
-  where
-    i = coinBalance (UTxO (Map.restrictKeys u (txBody ^. inputsTxBodyL)))
-    r = keyTxRefunds pp dpstate txBody
-    w = fold . unWithdrawals $ txBody ^. withdrawalsTxBodyL
+consumedTxBody txBody pp dpstate (UTxO u) =
+  Consumed
+    { conInputs = coinBalance (UTxO (Map.restrictKeys u (txBody ^. inputsTxBodyL)))
+    , conRefunds = keyTxRefunds pp dpstate txBody
+    , conWithdrawals = fold . unWithdrawals $ txBody ^. withdrawalsTxBodyL
+    }
 
 -- | Compute the Coin part of what is produced by a TxBody, itemized as a 'Produced'
 producedTxBody ::
@@ -143,8 +162,9 @@ producedTxBody ::
   PParams era ->
   DPState (EraCrypto era) ->
   Produced
-producedTxBody txBody pp dpstate = Produced {proOutputs = out, proFees = f, proDeposits = d}
-  where
-    out = coinBalance (txouts txBody)
-    f = txBody ^. feeTxBodyL
-    d = totalTxDeposits pp dpstate txBody
+producedTxBody txBody pp dpstate =
+  Produced
+    { proOutputs = coinBalance (txouts txBody)
+    , proFees = txBody ^. feeTxBodyL
+    , proDeposits = totalTxDeposits pp dpstate txBody
+    }

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

@@ -65,4 +65,5 @@ compareAdaPots xlabel x ylabel y =
     ]
   where
     n = 25
-    oneline name f = pad n name ++ pad n (show (f x)) ++ pad n (show (f y)) ++ pad n (show (f y <-> f x))
+    oneline name f =
+      pad n name ++ pad n (show (f x)) ++ pad n (show (f y)) ++ pad n (show (f y <-> f x))

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

@@ -49,6 +49,7 @@ module Cardano.Ledger.Shelley.LedgerState (
   minfee,
   produced,
   witsFromTxWitnesses,
+
 
   -- * DelegationState
   keyTxRefunds,
@@ -58,6 +59,7 @@ module Cardano.Ledger.Shelley.LedgerState (
   obligationDPState,
   keyCertsRefunds,
   totalCertsDeposits,
+  totalCertsDepositsDPState,
 
   -- * Epoch boundary
   incrementalStakeDistr,

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -9,6 +10,7 @@
 module Cardano.Ledger.Shelley.LedgerState.RefundsAndDeposits (
   totalTxDeposits,
   totalCertsDeposits,
+  totalCertsDepositsDPState,
   keyTxRefunds,
   keyCertsRefunds,
 )
@@ -54,51 +56,30 @@ import Lens.Micro ((^.))
 totalCertsDeposits ::
   (EraPParams era, Foldable f) =>
   PParams era ->
-  DPState (EraCrypto era) ->
+  -- | Check whether a pool with a supplied PoolStakeId is already registered.
+  (KeyHash 'StakePool (EraCrypto era) -> Bool) ->
   f (DCert (EraCrypto era)) ->
   Coin
-totalCertsDeposits pp dpstate =
-  totalCertsDepositsForRegPools pp (psStakePoolParams (dpsPState dpstate))
+totalCertsDeposits pp isRegPool certs =
+  numKeys <×> pp ^. ppKeyDepositL
+    <+> numNewRegPoolCerts <×> pp ^. ppPoolDepositL
+  where
+    numKeys = getSum @Int $ foldMap' (\x -> if isRegKey x then 1 else 0) certs
+    numNewRegPoolCerts = Set.size (foldl' addNewPoolIds Set.empty certs)
+    addNewPoolIds regPoolIds = \case
+      DCertPool (RegPool (PoolParams {ppId}))
+        -- We don't pay a deposit on a pool that is already registered or duplicated in the certs
+        | not (isRegPool ppId || Set.member ppId regPoolIds) -> Set.insert ppId regPoolIds
+      _ -> regPoolIds
 
-totalCertsDepositsForRegPools ::
+totalCertsDepositsDPState ::
   (EraPParams era, Foldable f) =>
   PParams era ->
-  -- | All of the registered pools. Could be restricted only to the pool ids that are
-  -- mentioned in the `RegPool` of supplied certificates.
-  Map.Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)) ->
+  DPState (EraCrypto era) ->
   f (DCert (EraCrypto era)) ->
   Coin
-totalCertsDepositsForRegPools pp regPools certs =
-  numKeys <×> pp ^. ppKeyDepositL
-    <+> snd (foldl' accum (Set.empty, Coin 0) certs)
-  where
-    numKeys :: Int
-    numKeys = getSum $ foldMap' (\x -> if isRegKey x then 1 else 0) certs
-    accum (!pools, !ans) (DCertPool (RegPool (PoolParams {ppId}))) =
-      -- We don't pay a deposit on a pool that is already registered
-      if Map.member ppId regPools || Set.member ppId pools
-        then (pools, ans)
-        else (Set.insert ppId pools, ans <+> pp ^. ppPoolDepositL)
-    accum ans _ = ans
-
--- totalRegDeposits ::
---   (EraPParams era, Foldable f) =>
---   PParams era ->
---   -- | Map of registered Stake Pools
---   Map (KeyHash 'StakePool c) (PoolParams c) ->
---   f (DCert c) ->
---   Coin
--- totalRegDeposits pp regPools poolIds =
---   numDelegKeys <×> pp ^. ppKeyDepositL
---     <+> numRegPoolIds <×> pp ^. ppPoolDepositL
---   where
---     -- numDelegKeys = length $ filter isRegKey certs -- alternative
---     numDelegKeys = getSum $ foldMap' (\x -> if isRegKey x then 1 else 0) certs
---     poolIds = Set.fromList (map getRegPoolId certs)
---     numRegPoolIds = Set.size poolIds - Map.size (regPools `Map.restrictKeys` poolIds)
---     getRegPoolId = \case
---       DCertPool (RegPool {ppId}) -> Just ppId
---       _ -> Nothing
+totalCertsDepositsDPState pp dpstate =
+  totalCertsDeposits pp (`Map.member` psStakePoolParams (dpsPState dpstate))
 
 totalTxDeposits ::
   ShelleyEraTxBody era =>
@@ -107,7 +88,7 @@ totalTxDeposits ::
   TxBody era ->
   Coin
 totalTxDeposits pp dpstate txb =
-  totalCertsDeposits pp dpstate (txb ^. certsTxBodyG)
+  totalCertsDepositsDPState pp dpstate (txb ^. certsTxBodyG)
 
 -- | Compute the key deregistration refunds in a transaction
 keyCertsRefunds ::

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

@@ -61,7 +61,13 @@ import Cardano.Ledger.SafeHash (SafeHash, hashAnnotated)
 import Cardano.Ledger.Shelley.AdaPots (consumedTxBody, producedTxBody)
 import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyUTXO)
 import Cardano.Ledger.Shelley.Governance
-import Cardano.Ledger.Shelley.LedgerState (DPState (..), PPUPPredFailure, UTxOState (..), keyTxRefunds, totalTxDeposits)
+import Cardano.Ledger.Shelley.LedgerState (
+  DPState (..),
+  PPUPPredFailure,
+  UTxOState (..),
+  keyTxRefunds,
+  totalTxDeposits,
+ )
 import Cardano.Ledger.Shelley.LedgerState.IncrementalStake
 import Cardano.Ledger.Shelley.PParams (Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (

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

@@ -34,13 +34,17 @@ import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.DPState (DPState)
+import Cardano.Ledger.DPState (DPState (..), PState (..))
+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, totalTxDeposits)
+import Cardano.Ledger.Shelley.LedgerState.RefundsAndDeposits (
+  keyTxRefunds,
+  totalCertsDeposits,
+ )
 import Cardano.Ledger.Shelley.PParams (Update)
 import Cardano.Ledger.Shelley.TxBody (
   ShelleyEraTxBody (..),
@@ -128,21 +132,20 @@ produced ::
   DPState (EraCrypto era) ->
   TxBody era ->
   Value era
-produced pp dpstate = getProducedCoin pp (psStakePoolParams (dpsPState dpstate))
-  -- balance (txouts txBody)
-  --   <+> Val.inject
-  --     (txBody ^. feeTxBodyL <+> totalTxDeposits pp dpstate txBody)
+produced pp dpstate =
+  getProducedValue pp (`Map.member` psStakePoolParams (dpsPState dpstate))
 
 getProducedValue ::
   ShelleyEraTxBody era =>
   PParams era ->
-  Map.Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)) ->
+  -- | Check whether a pool with a supplied PoolStakeId is already registered.
+  (KeyHash 'StakePool (EraCrypto era) -> Bool) ->
   TxBody era ->
   Value era
-getProducedValue pp regPools txBody =
+getProducedValue pp isRegPoolId txBody =
   sumAllValue (txBody ^. outputsTxBodyL)
     <+> Val.inject
-      (txBody ^. feeTxBodyL <+> totalCertsDepositsForRegPools pp regPools (txBody ^. certsTxBodyG))
+      (txBody ^. feeTxBodyL <+> totalCertsDeposits pp isRegPoolId (txBody ^. certsTxBodyG))
 
 -- | Compute the lovelace which are destroyed by the transaction
 getConsumedCoin ::

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

@@ -30,7 +30,7 @@ import Cardano.Ledger.Shelley.API (
   ShelleyDELPL,
  )
 import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..))
-import Cardano.Ledger.Shelley.LedgerState (DPState (..), keyCertsRefunds, totalCertsDeposits)
+import Cardano.Ledger.Shelley.LedgerState (DPState (..), keyCertsRefunds, totalCertsDepositsDPState)
 import Cardano.Ledger.Shelley.Rules (ShelleyDelplEvent, ShelleyDelplPredFailure)
 import Cardano.Ledger.Slot (SlotNo (..))
 import Control.Monad.Trans.Reader (runReaderT)
@@ -231,7 +231,7 @@ genDCerts
         refunds = keyCertsRefunds pparams dpState certs
     pure
       ( StrictSeq.fromList certs
-      , totalCertsDeposits pparams dpState certs
+      , totalCertsDepositsDPState pparams dpState certs
       , refunds
       , lastState_
       ,

libs/cardano-ledger-api/src/Cardano/Ledger/Api/Tx/Body.hs

@@ -74,30 +74,3 @@ import Cardano.Ledger.Conway.Core (ConwayEraTxBody (..))
 import Cardano.Ledger.Core (EraTxBody (..))
 import Cardano.Ledger.Mary.Core (MaryEraTxBody (..))
 import Cardano.Ledger.Shelley.Core (ShelleyEraTxBody (..))
-
-
--- | Evaluate the difference between the value currently being consumed by
--- a transaction and the number of lovelace being produced.
--- This value will be zero for a valid transaction.
-evalBalanceTxBody ::
-  ( EraUTxO era
-  , ShelleyEraTxBody era
-  ) =>
-  -- | Current protocol parameters
-  PParams era ->
-  -- | Registered Stake Pool
-  Map (KeyHash 'StakePool c) (PoolParams c) ->
-  -- | The UTxO relevant to the transaction.
-  UTxO era ->
-  -- | The transaction being evaluated for balance.
-  TxBody era ->
-  -- | The difference between what the transaction consumes and what it produces.
-  Value era
-evalBalanceTxBody pp dpstate u txb =
-  getConsumedValue pp dpstate u txb <-> produced pp dpstate txb
-
-
-
--- Need queries:
---  * [ppId] -> [PoolParams]
---