Resolve pointer addresses in updateStakeDistribution conditionally

on the protocol version, namely: don't resolve pointer addresses for
Conway era and later

eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs

@@ -206,7 +206,7 @@ utxoTransition = do
   let refunded = keyTxRefunds pp dpstate txb
   let depositChange = totalTxDeposits pp dpstate txb Val.<-> refunded
 
-  pure $! Shelley.updateUTxOState u txb depositChange ppup'
+  pure $! Shelley.updateUTxOState pp u txb depositChange ppup'
 
 -- | Ensure the transaction is within the validity window.
 --

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

@@ -256,7 +256,7 @@ scriptsValidateTransition = do
       TRC
         (PPUPEnv slot pp genDelegs, pup, strictMaybeToMaybe $ txBody ^. updateTxBodyL)
 
-  pure $! updateUTxOState u txBody depositChange ppup'
+  pure $! updateUTxOState pp u txBody depositChange ppup'
 
 scriptsNotValidateTransition ::
   forall era.
@@ -291,7 +291,7 @@ scriptsNotValidateTransition = do
     us
       { utxosUtxo = UTxO utxoKeep
       , utxosFees = fees <> coinBalance (UTxO utxoDel)
-      , utxosStakeDistr = updateStakeDistribution (utxosStakeDistr us) (UTxO utxoDel) mempty
+      , utxosStakeDistr = updateStakeDistribution pp (utxosStakeDistr us) (UTxO utxoDel) mempty
       }
 
 -- =======================================

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

@@ -191,7 +191,7 @@ scriptsYes = do
 
   let !_ = traceEvent validEnd ()
 
-  pure $! updateUTxOState u txBody depositChange ppup'
+  pure $! updateUTxOState pp u txBody depositChange ppup'
 
 scriptsNo ::
   forall era.
@@ -238,5 +238,5 @@ scriptsNo = do
       { utxosUtxo = UTxO (Map.union utxoKeep collouts) -- NEW to Babbage
       {- fees + collateralFees -}
       , utxosFees = fees <> collateralFees -- NEW to Babbage
-      , utxosStakeDistr = updateStakeDistribution (utxosStakeDistr us) (UTxO utxoDel) (UTxO collouts)
+      , utxosStakeDistr = updateStakeDistribution pp (utxosStakeDistr us) (UTxO utxoDel) (UTxO collouts)
       }

eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples.hs

@@ -35,17 +35,17 @@ testMaryNoDelegLEDGER ::
   Assertion
 testMaryNoDelegLEDGER utxo tx env (Right expectedUTxO) = do
   checkTrace @(ShelleyLEDGER Mary) runShelleyBase env $
-    pure (LedgerState (smartUTxOState utxo (Coin 0) (Coin 0) def) def) .- tx .->> expectedSt'
+    pure (LedgerState (smartUTxOState (ledgerPp env) utxo (Coin 0) (Coin 0) def) def) .- tx .->> expectedSt'
   where
     txFee = tx ^. bodyTxL . feeTxBodyL
-    expectedSt' = LedgerState (smartUTxOState expectedUTxO (Coin 0) txFee def) def
+    expectedSt' = LedgerState (smartUTxOState (ledgerPp env) expectedUTxO (Coin 0) txFee def) def
 testMaryNoDelegLEDGER utxo tx env predicateFailure@(Left _) = do
   let st =
         runShelleyBase $
           applySTSTest @(ShelleyLEDGER Mary)
             ( TRC
                 ( env
-                , LedgerState (smartUTxOState utxo (Coin 0) (Coin 0) def) def
+                , LedgerState (smartUTxOState (ledgerPp env) utxo (Coin 0) (Coin 0) def) def
                 , tx
                 )
             )

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

@@ -88,7 +88,7 @@ initialStateFromGenesis sg ag =
         (AccountState (Coin 0) reserves)
         emptySnapShots
         ( LedgerState
-            (smartUTxOState initialUtxo (Coin 0) (Coin 0) emptyGovernanceState)
+            (smartUTxOState (fromShelleyPParams ag pp) initialUtxo (Coin 0) (Coin 0) def)
             (DPState (def {dsGenDelegs = GenDelegs genDelegs}) def)
         )
         (fromShelleyPParams ag pp)

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

@@ -84,14 +84,15 @@ import Lens.Micro
 -- | Incrementally add the inserts 'utxoAdd' and the deletes 'utxoDel' to the IncrementalStake.
 updateStakeDistribution ::
   EraTxOut era =>
+  PParams era ->
   IncrementalStake (EraCrypto era) ->
   UTxO era ->
   UTxO era ->
   IncrementalStake (EraCrypto era)
-updateStakeDistribution incStake0 utxoDel utxoAdd = incStake2
+updateStakeDistribution pp incStake0 utxoDel utxoAdd = incStake2
   where
-    incStake1 = incrementalAggregateUtxoCoinByCredential id utxoAdd incStake0
-    incStake2 = incrementalAggregateUtxoCoinByCredential invert utxoDel incStake1
+    incStake1 = incrementalAggregateUtxoCoinByCredential pp id utxoAdd incStake0
+    incStake2 = incrementalAggregateUtxoCoinByCredential pp invert utxoDel incStake1
 
 -- | Incrementally sum up all the Coin, for each staking Credential, in the outputs of the UTxO, and
 --   "add" them to the IncrementalStake. "add" has different meaning depending on if we are inserting
@@ -104,11 +105,12 @@ updateStakeDistribution incStake0 utxoDel utxoAdd = incStake2
 incrementalAggregateUtxoCoinByCredential ::
   forall era.
   EraTxOut era =>
+  PParams era ->
   (Coin -> Coin) ->
   UTxO era ->
   IncrementalStake (EraCrypto era) ->
   IncrementalStake (EraCrypto era)
-incrementalAggregateUtxoCoinByCredential mode (UTxO u) initial =
+incrementalAggregateUtxoCoinByCredential pp mode (UTxO u) initial =
   Map.foldl' accum initial u
   where
     keepOrDelete new Nothing =
@@ -119,10 +121,14 @@ incrementalAggregateUtxoCoinByCredential mode (UTxO u) initial =
       case mode new <> old of
         Coin 0 -> Nothing
         final -> Just final
+    ignorePtrs = HardForks.forgoPointerAddressResolution (pp ^. ppProtocolVersionL)
     accum ans@(IStake stake ptrs) out =
       let c = out ^. coinTxOutL
        in case out ^. addrTxOutL of
-            Addr _ _ (StakeRefPtr p) -> IStake stake (Map.alter (keepOrDelete c) p ptrs)
+            Addr _ _ (StakeRefPtr p) ->
+              if ignorePtrs
+                then ans
+                else IStake stake (Map.alter (keepOrDelete c) p ptrs)
             Addr _ _ (StakeRefBase hk) -> IStake (Map.alter (keepOrDelete c) hk stake) ptrs
             _other -> ans
 
@@ -139,20 +145,20 @@ incrementalAggregateUtxoCoinByCredential mode (UTxO u) initial =
 --
 --   TO IncrementalStake
 smartUTxOState ::
-  ( EraTxOut era
-  ) =>
+  EraTxOut era =>
+  PParams era ->
   UTxO era ->
   Coin ->
   Coin ->
   GovernanceState era ->
   UTxOState era
-smartUTxOState utxo c1 c2 st =
+smartUTxOState pp utxo c1 c2 st =
   UTxOState
     utxo
     c1
     c2
     st
-    (updateStakeDistribution mempty mempty utxo)
+    (updateStakeDistribution pp mempty mempty utxo)
 
 -- =======================================================================
 -- Part 2. Compute a Snapshot using the IncrementalStake in Snap rule

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

@@ -417,7 +417,7 @@ utxoInductive = do
   let totalDeposits' = totalTxDeposits pp dpstate txb
   let depositChange = totalDeposits' Val.<-> refunded
   tellEvent $ TotalDeposits (hashAnnotated txb) depositChange
-  pure $! updateUTxOState u txb depositChange ppup'
+  pure $! updateUTxOState pp u txb depositChange ppup'
 
 -- | The ttl field marks the top of an open interval, so it must be strictly
 -- less than the slot, so fail if it is (>=).
@@ -579,19 +579,20 @@ validateMaxTxSizeUTxO pp tx =
 
 updateUTxOState ::
   (EraTxBody era, GovernanceState era ~ ShelleyPPUPState era) =>
+  PParams era ->
   UTxOState era ->
   TxBody era ->
   Coin ->
   ShelleyPPUPState era ->
   UTxOState era
-updateUTxOState UTxOState {utxosUtxo, utxosDeposited, utxosFees, utxosStakeDistr} txb depositChange ppups =
+updateUTxOState pp UTxOState {utxosUtxo, utxosDeposited, utxosFees, utxosStakeDistr} txb depositChange ppups =
   let UTxO utxo = utxosUtxo
       !utxoAdd = txouts txb -- These will be inserted into the UTxO
       {- utxoDel  = txins txb ◁ utxo -}
       !(utxoWithout, utxoDel) = extractKeys utxo (txb ^. inputsTxBodyL)
       {- newUTxO = (txins txb ⋪ utxo) ∪ outs txb -}
       newUTxO = utxoWithout `Map.union` unUTxO utxoAdd
-      newIncStakeDistro = updateStakeDistribution utxosStakeDistr (UTxO utxoDel) utxoAdd
+      newIncStakeDistro = updateStakeDistribution pp utxosStakeDistr (UTxO utxoDel) utxoAdd
    in UTxOState
         { utxosUtxo = UTxO newUTxO
         , utxosDeposited = utxosDeposited <> depositChange

eras/shelley/test-suite/bench/Main.hs

@@ -224,7 +224,7 @@ epochAt x =
       ("UTxO=" ++ show x ++ ",  address=" ++ show n)
       [ bench "stakeDistr" (nf action2m arg)
       , bench "incrementalStakeDistr" (nf action2im arg)
-      , env (pure (updateStakeDistribution mempty mempty utxo)) $ \incStake ->
+      , env (pure (updateStakeDistribution emptyPParams mempty mempty utxo)) $ \incStake ->
           bench "incrementalStakeDistr (no update)" $
             nf (incrementalStakeDistr (emptyPParams @C) incStake dstate) pstate
       ]
@@ -243,8 +243,9 @@ action2im ::
   (DState (EraCrypto era), PState (EraCrypto era), UTxO era) ->
   EB.SnapShot (EraCrypto era)
 action2im (dstate, pstate, utxo) =
-  let incStake = updateStakeDistribution mempty mempty utxo
-   in incrementalStakeDistr (emptyPParams @era) incStake dstate pstate
+  let pp = emptyPParams @era
+      incStake = updateStakeDistribution pp mempty mempty utxo
+   in incrementalStakeDistr pp incStake dstate pstate
 
 -- =================================================================
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs

@@ -211,6 +211,7 @@ initialShelleyState lab e utxo reserves genDelegs pp initNonce =
             emptySnapShots
             ( LedgerState
                 ( smartUTxOState
+                    pp
                     utxo
                     (Coin 0)
                     (Coin 0)

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs

@@ -255,7 +255,7 @@ newUTxO txb cs = cs {chainNes = nes'}
     utxoWithout = Map.withoutKeys utxo (txins @era txb)
     utxoDel = UTxO utxoToDel
     utxo' = UTxO (utxoWithout `Map.union` unUTxO utxoAdd)
-    sd' = updateStakeDistribution @era (utxosStakeDistr utxoSt) utxoDel utxoAdd
+    sd' = updateStakeDistribution @era (esPp es) (utxosStakeDistr utxoSt) utxoDel utxoAdd
     utxoSt' = utxoSt {utxosUtxo = utxo', utxosStakeDistr = sd'}
     ls' = ls {lsUTxOState = utxoSt'}
     es' = es {esLState = ls'}

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs

@@ -177,7 +177,7 @@ initialBBodyState ::
 initialBBodyState pf utxo =
   BbodyState (LedgerState initialUtxoSt dpstate) (BlocksMade mempty)
   where
-    initialUtxoSt = smartUTxOState utxo (UM.fromCompact successDeposit) (Coin 0) def
+    initialUtxoSt = smartUTxOState (pp pf) utxo (UM.fromCompact successDeposit) (Coin 0) def
     dpstate =
       def
         { dpsDState =
@@ -652,7 +652,7 @@ testBBodyState pf =
           , DHash' [hashData $ someDatum @era]
           ]
       poolID = hashKey . vKey . coerceKeyRole $ coldKeys
-      example1UtxoSt = smartUTxOState utxo totalDeposits (Coin 40) def
+      example1UtxoSt = smartUTxOState (pp pf) utxo totalDeposits (Coin 40) def
       -- the default DPState 'def' means that the 'totalDeposits' must be 0
       totalDeposits = (Coin 0)
    in BbodyState

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoValidTxUTXOW.hs

@@ -232,7 +232,7 @@ validatingState ::
   ) =>
   Proof era ->
   UTxOState era
-validatingState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingBody pf) (validatingTxOut pf)) 1
 
@@ -287,7 +287,7 @@ notValidatingState ::
   ) =>
   Proof era ->
   UTxOState era
-notValidatingState pf = smartUTxOState (expectedUTxO' pf ExpectFailure 2) (Coin 0) (Coin 5) def
+notValidatingState pf = smartUTxOState (pp pf) (expectedUTxO' pf ExpectFailure 2) (Coin 0) (Coin 5) def
 
 -- =========================================================================
 --  Example 3: Process a CERT transaction with a succeeding Plutus script.
@@ -339,7 +339,7 @@ validatingWithCertState ::
   ) =>
   Proof era ->
   UTxOState era
-validatingWithCertState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingWithCertState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingWithCertBody pf) (validatingWithCertTxOut pf)) 3
 
@@ -387,7 +387,7 @@ notValidatingWithCertState ::
   ) =>
   Proof era ->
   UTxOState era
-notValidatingWithCertState pf = smartUTxOState (expectedUTxO' pf ExpectFailure 4) (Coin 0) (Coin 5) def
+notValidatingWithCertState pf = smartUTxOState (pp pf) (expectedUTxO' pf ExpectFailure 4) (Coin 0) (Coin 5) def
 
 -- ==============================================================================
 --  Example 5: Process a WITHDRAWAL transaction with a succeeding Plutus script.
@@ -441,7 +441,7 @@ validatingWithWithdrawalState ::
   (EraTxBody era, PostShelley era, EraGovernance era) =>
   Proof era ->
   UTxOState era
-validatingWithWithdrawalState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingWithWithdrawalState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingWithWithdrawalBody pf) (validatingWithWithdrawalTxOut pf)) 5
 
@@ -490,7 +490,7 @@ notValidatingWithWithdrawalState ::
   (EraTxBody era, PostShelley era, EraGovernance era) =>
   Proof era ->
   UTxOState era
-notValidatingWithWithdrawalState pf = smartUTxOState (expectedUTxO' pf ExpectFailure 6) (Coin 0) (Coin 5) def
+notValidatingWithWithdrawalState pf = smartUTxOState (pp pf) (expectedUTxO' pf ExpectFailure 6) (Coin 0) (Coin 5) def
 
 -- =============================================================================
 --  Example 7: Process a MINT transaction with a succeeding Plutus script.
@@ -548,7 +548,7 @@ validatingWithMintState ::
   (PostShelley era, EraTxBody era, HasTokens era, Value era ~ MaryValue (EraCrypto era), EraGovernance era) =>
   Proof era ->
   UTxOState era
-validatingWithMintState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingWithMintState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingWithMintBody pf) (validatingWithMintTxOut pf)) 7
 
@@ -596,7 +596,7 @@ notValidatingWithMintState ::
   (EraTxBody era, PostShelley era, EraGovernance era) =>
   Proof era ->
   UTxOState era
-notValidatingWithMintState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+notValidatingWithMintState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf ExpectFailure 8
 
@@ -688,7 +688,7 @@ validatingManyScriptsState ::
   (EraTxBody era, PostShelley era, HasTokens era, Value era ~ MaryValue (EraCrypto era), EraGovernance era) =>
   Proof era ->
   UTxOState era
-validatingManyScriptsState pf = smartUTxOState (UTxO utxo) (Coin 0) (Coin 5) def
+validatingManyScriptsState pf = smartUTxOState (pp pf) (UTxO utxo) (Coin 0) (Coin 5) def
   where
     utxo =
       Map.insert (TxIn (txid (validatingManyScriptsBody pf)) minBound) (validatingManyScriptsTxOut pf) $
@@ -745,7 +745,7 @@ validatingSupplimentaryDatumState ::
   (EraTxBody era, PostShelley era, EraGovernance era) =>
   Proof era ->
   UTxOState era
-validatingSupplimentaryDatumState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingSupplimentaryDatumState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingSupplimentaryDatumBody pf) (validatingSupplimentaryDatumTxOut pf)) 3
 
@@ -801,7 +801,7 @@ validatingMultipleEqualCertsState ::
   (EraTxBody era, PostShelley era, EraGovernance era) =>
   Proof era ->
   UTxOState era
-validatingMultipleEqualCertsState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingMultipleEqualCertsState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingMultipleEqualCertsBody pf) (validatingMultipleEqualCertsOut pf)) 3
 
@@ -849,7 +849,7 @@ validatingNonScriptOutWithDatumState ::
   ) =>
   Proof era ->
   UTxOState era
-validatingNonScriptOutWithDatumState pf = smartUTxOState utxo (Coin 0) (Coin 5) def
+validatingNonScriptOutWithDatumState pf = smartUTxOState (pp pf) utxo (Coin 0) (Coin 5) def
   where
     utxo = expectedUTxO' pf (ExpectSuccess (validatingNonScriptOutWithDatumTxBody pf) (validatingNonScriptOutWithDatumTxOut pf)) 103
 

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs

@@ -1061,7 +1061,7 @@ testExpectSuccessValid
 
         initUtxo = (UTxO . Map.fromList) $ inputs' ++ refInputs' ++ collateral'
         expectedUtxo = UTxO $ Map.fromList (newTxInOut ++ refInputs' ++ collateral')
-        expectedState = smartUTxOState expectedUtxo (Coin 0) fees def
+        expectedState = smartUTxOState (pp pf) expectedUtxo (Coin 0) fees def
         assumedValidTx = trustMeP pf True tx'
      in testUTXOW (UTXOW pf) initUtxo (pp pf) assumedValidTx (Right expectedState)
 
@@ -1102,7 +1102,7 @@ testExpectSuccessInvalid
         initUtxo = UTxO . Map.fromList $ inputs' ++ refInputs' ++ collateral'
         colBallance = Collateral.collAdaBalance txBody' (Map.fromList collateral')
         expectedUtxo = UTxO $ Map.fromList (inputs' ++ refInputs' ++ newColReturn txBody')
-        expectedState = smartUTxOState expectedUtxo (Coin 0) colBallance def
+        expectedState = smartUTxOState (pp pf) expectedUtxo (Coin 0) colBallance def
         assumedInvalidTx = trustMeP pf False tx'
      in testUTXOW (UTXOW pf) initUtxo (pp pf) assumedInvalidTx (Right expectedState)
 

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/STSTestUtils.hs

@@ -365,7 +365,7 @@ testUTXOWsubset (UTXOW other) _ = error ("Cannot use testUTXOW in era " ++ show
 -- | Use a test where any two (ValidationTagMismatch x y) failures match regardless of 'x' and 'y'
 testUTXOspecialCase wit@(UTXOW proof) utxo pparam tx expected =
   let env = UtxoEnv (SlotNo 0) pparam def (GenDelegs mempty)
-      state = smartUTxOState utxo (Coin 0) (Coin 0) def
+      state = smartUTxOState pparam utxo (Coin 0) (Coin 0) def
    in case proof of
         Alonzo _ -> runSTS wit (TRC (env, state, tx)) (specialCont proof expected)
         Babbage _ -> runSTS wit (TRC (env, state, tx)) (specialCont proof expected)
@@ -396,7 +396,7 @@ testUTXOWwith ::
   Assertion
 testUTXOWwith wit@(UTXOW proof) cont utxo pparams tx expected =
   let env = UtxoEnv (SlotNo 0) pparams def (GenDelegs mempty)
-      state = smartUTxOState utxo (Coin 0) (Coin 0) def
+      state = smartUTxOState pparams utxo (Coin 0) (Coin 0) def
    in case proof of
         Conway _ -> runSTS wit (TRC (env, state, tx)) (cont expected)
         Babbage _ -> runSTS wit (TRC (env, state, tx)) (cont expected)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/GenState.hs

@@ -692,7 +692,7 @@ initialLedgerState :: forall era. Reflect era => GenState era -> LedgerState era
 initialLedgerState gstate = LedgerState utxostate dpstate
   where
     umap = UM.unify (Map.map rdpair (gsInitialRewards gstate)) (gsInitialDelegations gstate) Map.empty
-    utxostate = smartUTxOState (UTxO (gsInitialUtxo gstate)) deposited (Coin 0) emptyGovernanceState
+    utxostate = smartUTxOState pp (UTxO (gsInitialUtxo gstate)) deposited (Coin 0) emptyGovernanceState
     dpstate = DPState dstate pstate
     dstate =
       DState