cleaned up things - pass 1.

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -507,7 +507,7 @@ utxoTransition = do
   runTest $ Shelley.validateBadInputsUTxO utxo inputsAndCollateral
 
   {- consumed pp utxo txb = produced pp poolParams txb -}
-  runTest $ Shelley.validateValueNotConservedUTxO pp dpstate utxo txBody
+  runTest $ Shelley.validateValueNotConservedUTxO pp utxo dpstate txBody
 
   {- adaPolicy ∉ supp mint tx
      above check not needed because mint field of type MultiAsset cannot contain ada -}

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -115,10 +115,10 @@ instance
     Environment (EraRule "PPUP" era) ~ PpupEnv era,
     State (EraRule "PPUP" era) ~ PPUPState era,
     Signal (EraRule "PPUP" era) ~ Maybe (Update era),
-    HasField "_keyDeposit" (PParams era) Coin,
-    HasField "_poolDeposit" (PParams era) Coin,
     HasField "_costmdls" (PParams era) CostModels,
     HasField "_protocolVersion" (PParams era) ProtVer,
+    HasField "_keyDeposit" (PParams era) Coin,
+    HasField "_poolDeposit" (PParams era) Coin,
     ToCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure
   ) =>
   STS (AlonzoUTXOS era)
@@ -158,9 +158,9 @@ utxosTransition ::
     State (EraRule "PPUP" era) ~ PPUPState era,
     Signal (EraRule "PPUP" era) ~ Maybe (Update era),
     Embed (EraRule "PPUP" era) (AlonzoUTXOS era),
+    HasField "_costmdls" (PParams era) CostModels,
     HasField "_keyDeposit" (PParams era) Coin,
     HasField "_poolDeposit" (PParams era) Coin,
-    HasField "_costmdls" (PParams era) CostModels,
     ToCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure
   ) =>
   TransitionRule (AlonzoUTXOS era)
@@ -214,15 +214,15 @@ scriptsValidateTransition ::
   ( AlonzoEraTx era,
     ExtendedUTxO era,
     EraUTxO era,
-    HasField "_keyDeposit" (PParams era) Coin,
-    HasField "_poolDeposit" (PParams era) Coin,
     ScriptsNeeded era ~ AlonzoScriptsNeeded era,
     STS (AlonzoUTXOS era),
     Script era ~ AlonzoScript era,
     Environment (EraRule "PPUP" era) ~ PpupEnv era,
     State (EraRule "PPUP" era) ~ PPUPState era,
     Signal (EraRule "PPUP" era) ~ Maybe (Update era),
     Embed (EraRule "PPUP" era) (AlonzoUTXOS era),
+    HasField "_keyDeposit" (PParams era) Coin,
+    HasField "_poolDeposit" (PParams era) Coin,
     HasField "_costmdls" (PParams era) CostModels
   ) =>
   TransitionRule (AlonzoUTXOS era)

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs

@@ -449,4 +449,3 @@ instance ToExpr Prices
 
 instance ToExpr ExUnits where
   toExpr (WrapExUnits (ExUnits' x y)) = App "ExUnits" [defaultExprViaShow x, defaultExprViaShow y]
-

eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs

@@ -374,7 +374,7 @@ utxoTransition = do
   runTest $ Shelley.validateBadInputsUTxO utxo allInputs
 
   {- consumed pp utxo txb = produced pp poolParams txb -}
-  runTest $ Shelley.validateValueNotConservedUTxO pp dpstate utxo txBody
+  runTest $ Shelley.validateValueNotConservedUTxO pp utxo dpstate txBody
 
   {-   adaID ∉ supp mint tx - check not needed because mint field of type MultiAsset
    cannot contain ada -}

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs

@@ -200,7 +200,7 @@ utxoTransition = do
   runTest $ Shelley.validateWrongNetworkWithdrawal netId txb
 
   {- consumed pp utxo txb = produced pp poolParams txb -}
-  runTest $ Shelley.validateValueNotConservedUTxO pp dpstate utxo txb
+  runTest $ Shelley.validateValueNotConservedUTxO pp utxo dpstate txb
 
   -- process Protocol Parameter Update Proposals
   ppup' <-

eras/shelley/impl/cardano-ledger-shelley.cabal

@@ -68,13 +68,11 @@ library
     Cardano.Ledger.Shelley.TxBody
     Cardano.Ledger.Shelley.TxOut
     Cardano.Ledger.Shelley.UTxO
-    Cardano.Ledger.Shelley.Era
-    Cardano.Ledger.Shelley.LedgerState.Types
     Cardano.Ledger.Shelley.LedgerState.DPState
     Cardano.Ledger.Shelley.LedgerState.ToExprOrphans
-
   other-modules:
-
+    Cardano.Ledger.Shelley.Era
+    Cardano.Ledger.Shelley.LedgerState.Types
     Cardano.Ledger.Shelley.LedgerState.IncrementalStake
     Cardano.Ledger.Shelley.LedgerState.NewEpochState
     Cardano.Ledger.Shelley.LedgerState.PulsingReward

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

@@ -12,6 +12,10 @@ module Cardano.Ledger.Shelley.AdaPots
     totalAdaES,
     totalAdaPotsES,
     compareAdaPots,
+    Produced (..),
+    Consumed (..),
+    consumedTxBody,
+    producedTxBody,
   )
 where
 
@@ -25,11 +29,18 @@ import Cardano.Ledger.Shelley.LedgerState
     LedgerState (..),
     PState (..),
     UTxOState (..),
+    keyTxRefunds,
     rewards,
+    totalTxDeposits,
   )
-import Cardano.Ledger.UTxO (coinBalance)
+import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody (..), unWdrl)
+import Cardano.Ledger.UTxO (UTxO (..), balance, coinBalance, txouts)
 import Cardano.Ledger.Val ((<->))
+import qualified Cardano.Ledger.Val as Val
 import Data.Foldable (fold)
+import qualified Data.Map.Strict as Map
+import GHC.Records (HasField (..))
+import Lens.Micro ((^.))
 
 data AdaPots = AdaPots
   { treasuryAdaPot :: Coin,
@@ -82,12 +93,69 @@ totalAdaES cs =
         reservesAdaPot,
         rewardsAdaPot,
         utxoAdaPot,
-        -- keyDepositAdaPot,
-        -- poolDepositAdaPot,
+        -- keyDepositAdaPot,  -- We don't count these two, as their
+        -- poolDepositAdaPot, -- sum is always depositsAdaPot
         depositsAdaPot,
         feesAdaPot
       } = totalAdaPotsES cs
 
+-- =============================================
+-- Produced and Consumed are specialized AdaPots
+-- relative to the actions of a TxBody
+
+-- | Itemizing what is consumed by a transaction
+data Consumed = Consumed
+  {conInputs :: !Coin, conRefunds :: !Coin, conWithdrawals :: !Coin}
+
+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)
+
+-- | Itemizing what is Produced by a transaction
+data Produced = Produced
+  {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)
+
+-- =========================
+
+-- | Compute the Coin part of what is consumed by a TxBody, itemized as a 'Consume'
+consumedTxBody ::
+  ( HasField "_keyDeposit" pp Coin,
+    ShelleyEraTxBody era
+  ) =>
+  TxBody era ->
+  pp ->
+  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 . unWdrl $ txBody ^. wdrlsTxBodyL
+
+-- | Compute the Coin part of what is produced by a TxBody, itemized as a 'Produced'
+producedTxBody ::
+  ( ShelleyEraTxBody era,
+    HasField "_keyDeposit" pp Coin,
+    HasField "_poolDeposit" pp Coin
+  ) =>
+  TxBody era ->
+  pp ->
+  DPState (EraCrypto era) ->
+  Produced
+producedTxBody txBody pp dpstate = Produced {proOutputs = out, proFees = f, proDeposits = d}
+  where
+    out = Val.coin (balance (txouts txBody))
+    f = txBody ^. feeTxBodyL
+    d = totalTxDeposits pp dpstate txBody
+
+-- ==============================================
+-- Compare two AdaPots, item by item
+
 pad :: Int -> String -> String
 pad n x = if m < n then x ++ [const ' ' i | i <- [1 .. n - m]] else x
   where

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

@@ -19,7 +19,6 @@ import Cardano.Ledger.Shelley.LedgerState
     InstantaneousRewards (..),
     PState (..),
     UTxOState (..),
-    deltaTxDeposit,
     keyTxRefunds,
     obligationDPState,
     produced,
@@ -28,7 +27,7 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.TxBody
 import Cardano.Ledger.Slot (EpochNo, SlotNo)
 import Cardano.Ledger.UTxO (DepositInfo, EraUTxO, UTxO (..), balance, coinBalance, getConsumedValue, txouts)
-import Cardano.Ledger.Val ((<+>))
+import Cardano.Ledger.Val ((<+>), (<->))
 import Data.Foldable (fold, toList)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -64,6 +63,11 @@ showCerts certs = unlines (map (("  " ++) . synopsisCert) certs)
 showTxCerts :: ShelleyEraTxBody era => Core.TxBody era -> String
 showTxCerts txb = showCerts (toList (txb ^. certsTxBodyL))
 
+-- | Display a synopsis of a map to Coin
+synopsisCoinMap :: Maybe (Map.Map k Coin) -> String
+synopsisCoinMap (Just m) = "Count = " ++ show (Map.size m) ++ ",  total = " ++ show (fold m)
+synopsisCoinMap Nothing = "SYNOPSIS NOTHING"
+
 -- ===============================================
 -- Printing Produced == Consumed
 
@@ -145,7 +149,7 @@ showLEDGERrule slot pp utxoSt dpstate@(DPState dst pst) tx =
           ++ ", utxosDeposited = "
           ++ show dep
           ++ ", delta = "
-          ++ show (deltaTxDeposit pp dpstate (tx ^. bodyTxL))
+          ++ show (totalTxDeposits pp dpstate (tx ^. bodyTxL) <-> keyTxRefunds pp dpstate (tx ^. bodyTxL))
       )
 
 showPoolReap ::

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

@@ -57,7 +57,6 @@ module Cardano.Ledger.Shelley.LedgerState
     payPoolDeposit,
     refundKeyDeposit,
     refundPoolDeposit,
-    deltaTxDeposit,
     totalTxDeposits,
 
     -- * Epoch boundary

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

@@ -24,13 +24,10 @@ module Cardano.Ledger.Shelley.LedgerState.DPState
     refundKeyDeposit,
     refundPoolDeposit,
     obligationDPState,
-    deltaTxDeposit,
-    deltaCertsDeposit,
     totalTxDeposits,
     totalCertsDeposits,
     keyTxRefunds,
     keyCertsRefunds,
-    depositTest,
   )
 where
 
@@ -74,14 +71,13 @@ import Cardano.Ledger.Slot
     SlotNo (..),
   )
 import Cardano.Ledger.UnifiedMap (UMap (UnifiedMap), UnifiedMap, View (Delegations, Rewards), ViewMap)
-import Cardano.Ledger.Val ((<+>), (<->), (<×>))
+import Cardano.Ledger.Val ((<+>), (<×>))
 import Control.DeepSeq (NFData)
 import Control.Monad.Trans
 import Data.Default.Class (Default (def))
 import Data.Foldable (foldl', toList)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Sequence.Strict (StrictSeq)
 import qualified Data.UMap as UM
 import GHC.Generics (Generic)
 import GHC.Records (HasField (..))
@@ -343,27 +339,13 @@ refundPoolDeposit keyhash pstate = (coin, pstate {psDeposits = newpool})
       Just c -> (c, Map.delete keyhash pool)
       Nothing -> (mempty, pool)
 
--- | Calculate total possible refunds in the system
+-- | Calculate total possible refunds in the system. There is an invariant that
+--   this should be the same as the utxosDeposited field of the UTxOState. Note that
+--   this does not depend upon the current values of the Key and Pool deposits of the PParams.
 obligationDPState :: DPState era -> Coin
 obligationDPState (DPState DState {dsDeposits = keys} PState {psDeposits = stakePools}) =
   foldl' (<>) (Coin 0) keys <> foldl' (<>) (Coin 0) stakePools
 
-{-
-obligation ::
-  forall c pp t.
-  ( HasField "_keyDeposit" pp Coin,
-    HasField "_poolDeposit" pp Coin,
-    Foldable (t (Credential 'Staking c))
-  ) =>
-  pp ->
-  t (Credential 'Staking c) Coin ->
-  Map (KeyHash 'StakePool c) (PoolParams c) ->
-  Coin
-obligation pp rewards stakePools =
-  (length rewards <×> getField @"_keyDeposit" pp)
-    <+> (length stakePools <×> getField @"_poolDeposit" pp)
--}
-
 -- | Determine the total deposit amount needed from a TxBody.
 -- The block may (legitimately) contain multiple registration certificates
 -- for the same pool, where the first will be treated as a registration and
@@ -436,57 +418,3 @@ keyTxRefunds ::
   TxBody era ->
   Coin
 keyTxRefunds pp dpstate tx = keyCertsRefunds pp dpstate (toList $ tx ^. certsTxBodyL)
-
--- | Compute the change in the deposit caused by 'running' the certificates of one Tx
---   This is a replacement function for 'totalDeposits', and 'keyRefunds' which did not take
---   the DPState as input, and thus could not accurately compute the answer.
---   Note that the set of registered keys and registered pools can grow when we see RegKey and RegPool
---   We have to track this properly because a Tx may have both a RegKey and a DeRegKey
-deltaCertsDeposit ::
-  ( HasField "_keyDeposit" pp Coin,
-    HasField "_poolDeposit" pp Coin
-  ) =>
-  pp ->
-  DPState c ->
-  StrictSeq (DCert c) ->
-  Coin
-deltaCertsDeposit pp dpstate certs = (\(_, _, c) -> c) $ foldl' accum (regpools, regkeys, Coin 0) certs
-  where
-    regpools = psStakePoolParams (dpsPState dpstate)
-    regkeys = dsDeposits (dpsDState dpstate)
-    accum (pools, keys, ans) (DCertDeleg (DeRegKey k)) =
-      -- If the key is registered subtract whatever deposit that was initially made from ans
-      -- if it is not registered, then just return ans
-      case Map.lookup k keys of
-        Just deposit -> (pools, keys, ans <-> deposit)
-        Nothing -> (pools, keys, ans)
-    accum (pools, keys, ans) (DCertDeleg (RegKey k)) =
-      (pools, Map.insert k (getField @"_keyDeposit" pp) keys, ans <+> getField @"_keyDeposit" pp)
-    accum (pools, keys, ans) (DCertPool (RegPool poolparam)) =
-      if Map.member (ppId poolparam) pools -- We don't pay a deposit on a pool that is already registered
-        then (pools, keys, ans)
-        else (Map.insert (ppId poolparam) poolparam pools, keys, ans <+> getField @"_poolDeposit" pp)
-    accum ans _ = ans
-
-deltaTxDeposit ::
-  ( HasField "_keyDeposit" pp Coin,
-    HasField "_poolDeposit" pp Coin,
-    ShelleyEraTxBody era
-  ) =>
-  pp ->
-  DPState (EraCrypto era) ->
-  TxBody era ->
-  Coin
-deltaTxDeposit pp dpstate txb = deltaCertsDeposit pp dpstate (txb ^. certsTxBodyL)
-
-depositTest ::
-  ( HasField "_keyDeposit" pp Coin,
-    HasField "_poolDeposit" pp Coin,
-    ShelleyEraTxBody era
-  ) =>
-  pp ->
-  DPState (EraCrypto era) ->
-  TxBody era ->
-  Bool
-depositTest pp dpstate txb =
-  deltaTxDeposit pp dpstate txb == totalTxDeposits pp dpstate txb <-> keyTxRefunds pp dpstate txb

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

@@ -16,7 +16,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Shelley.LedgerState.Types where
 

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

@@ -383,7 +383,8 @@ delegationTransition = do
 
 checkSlotNotTooLate ::
   ( Typeable era,
-    HasField "_protocolVersion" (PParams era) ProtVer
+    HasField "_protocolVersion" (PParams era) ProtVer,
+    HasField "_keyDeposit" (PParams era) Coin
   ) =>
   SlotNo ->
   Rule (ShelleyDELEG era) 'Transition ()