Merge pull request #4867 from IntersectMBO/lehins/initial-attempt-at-…

…approach-of-using-lenses-for-managing-ledger-state

Add `CanGetUTxO` and `CanSetUTxO` type classes

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs

@@ -81,10 +81,8 @@ import Cardano.Ledger.Plutus (
  )
 import Cardano.Ledger.Shelley.LedgerState (
   curPParamsEpochStateL,
-  esLStateL,
-  lsUTxOStateL,
   nesEsL,
-  utxosUtxoL,
+  utxoL,
  )
 import Cardano.Ledger.Shelley.UTxO (EraUTxO (..), ScriptsProvided (..), UTxO (..), txouts)
 import Cardano.Ledger.TxIn (TxIn)
@@ -162,7 +160,7 @@ impGetPlutusContexts ::
   ImpTestM era [(PlutusPurpose AsIxItem era, ScriptHash, ScriptTestContext)]
 impGetPlutusContexts tx = do
   let txBody = tx ^. bodyTxL
-  utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+  utxo <- getsNES utxoL
   let AlonzoScriptsNeeded asn = getScriptsNeeded utxo txBody
   mbyContexts <- forM asn $ \(prp, sh) -> do
     pure $ (prp,sh,) <$> impGetScriptContextMaybe @era sh
@@ -529,15 +527,15 @@ expectTxSuccess ::
   Tx era -> ImpTestM era ()
 expectTxSuccess tx
   | tx ^. isValidTxL == IsValid True = do
-      utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+      utxo <- getsNES utxoL
       let inputs = Set.toList $ tx ^. bodyTxL . inputsTxBodyL
           outputs = Map.toList . unUTxO . txouts $ tx ^. bodyTxL
       impAnn "Inputs should be gone from UTxO" $
         expectUTxOContent utxo [(txIn, isNothing) | txIn <- inputs]
       impAnn "Outputs should be in UTxO" $
         expectUTxOContent utxo [(txIn, (== Just txOut)) | (txIn, txOut) <- outputs]
   | otherwise = do
-      utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+      utxo <- getsNES utxoL
       let inputs = tx ^. bodyTxL . inputsTxBodyL
           collaterals = tx ^. bodyTxL . collateralInputsTxBodyL
           outputs = Map.toList . unUTxO . txouts $ tx ^. bodyTxL

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs

@@ -27,7 +27,6 @@ import Cardano.Ledger.Plutus.Evaluate (PlutusWithContext (..), ScriptResult (..)
 import Cardano.Ledger.Plutus.Language (plutusFromRunnable)
 import Cardano.Ledger.Shelley.LedgerState hiding (circulation)
 import Cardano.Ledger.Slot (EpochSize (..))
-import Cardano.Ledger.UTxO (UTxO (..))
 import Cardano.Slotting.EpochInfo (fixedEpochInfo)
 import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
 import Control.State.Transition

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs

@@ -94,8 +94,8 @@ import Cardano.Ledger.Shelley.LedgerState (
   LedgerState (..),
   UTxOState (..),
   asTreasuryL,
+  utxoL,
   utxosGovStateL,
-  utxosUtxoL,
  )
 import Cardano.Ledger.Shelley.Rules (
   LedgerEnv (..),
@@ -407,7 +407,7 @@ ledgerTransition = do
                       }
                   )
 
-        let totalRefScriptSize = txNonDistinctRefScriptsSize (utxoState ^. utxosUtxoL) tx
+        let totalRefScriptSize = txNonDistinctRefScriptsSize (utxoState ^. utxoL) tx
         totalRefScriptSize
           <= maxRefScriptSizePerTx
             ?! ConwayTxRefScriptsSizeTooBig

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -209,9 +209,9 @@ import Cardano.Ledger.Shelley.LedgerState (
   newEpochStateGovStateL,
   produced,
   unifiedL,
+  utxoL,
   utxosGovStateL,
   utxosStakeDistrL,
-  utxosUtxoL,
   vsCommitteeStateL,
   vsDRepsL,
  )
@@ -1761,7 +1761,7 @@ logConwayTxBalance ::
 logConwayTxBalance tx = do
   pp <- getsPParams id
   certState <- getsNES $ nesEsL . esLStateL . lsCertStateL
-  utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+  utxo <- getsNES utxoL
   logString $ showConwayTxBalance pp certState utxo tx
 
 submitBootstrapAwareFailingVote ::

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.16.0.0
 
+* Deprecated `utxosUtxoL`
+* Added `CanGetUTxO` and `CanSetUTxO` instances for `EpochState`, `UTxOState`, `NewEpochState`, `LedgerState` 
 * Made the fields of predicate failures and environments lazy
 * Changed the type of `sgSecurityParam` to `NonZero Word64`
 * Following functions now expect a `NonZero Word64` security parameter:

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

@@ -10,6 +10,12 @@
 -- as state transformations on a ledger state ('LedgerState'),
 -- as specified in /A Simplified Formal Specification of a UTxO Ledger/.
 module Cardano.Ledger.Shelley.LedgerState (
+  -- * UTxO
+  UTxO (..),
+  CanGetUTxO (..),
+  CanSetUTxO (..),
+
+  -- * Others to organize
   AccountState (..),
   CertState (..),
   DState (..),
@@ -159,3 +165,4 @@ import Cardano.Ledger.Shelley.PParams (pvCanFollow)
 import Cardano.Ledger.Shelley.RewardUpdate
 import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyGovState (..))
 import Cardano.Ledger.Shelley.UTxO (consumed, produced)
+import Cardano.Ledger.UTxO (CanGetUTxO (..), CanSetUTxO (..), UTxO (..))

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

@@ -68,7 +68,7 @@ import Cardano.Ledger.Shelley.Era (ShelleyEra)
 import Cardano.Ledger.Shelley.PoolRank (NonMyopic (..))
 import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..))
 import Cardano.Ledger.UMap (UMap (..))
-import Cardano.Ledger.UTxO (UTxO (..))
+import Cardano.Ledger.UTxO (CanGetUTxO (..), CanSetUTxO (..), UTxO (..))
 import Control.DeepSeq (NFData)
 import Control.Monad.State.Strict (evalStateT)
 import Control.Monad.Trans (MonadTrans (lift))
@@ -130,6 +130,11 @@ data EpochState era = EpochState
   }
   deriving (Generic)
 
+instance CanGetUTxO EpochState
+instance CanSetUTxO EpochState where
+  utxoL = (lens esLState $ \s ls -> s {esLState = ls}) . utxoL
+  {-# INLINE utxoL #-}
+
 deriving stock instance
   ( EraTxOut era
   , Show (GovState era)
@@ -285,6 +290,11 @@ data UTxOState era = UTxOState
   }
   deriving (Generic)
 
+instance CanGetUTxO UTxOState
+instance CanSetUTxO UTxOState where
+  utxoL = lens utxosUtxo $ \s u -> s {utxosUtxo = u}
+  {-# INLINE utxoL #-}
+
 instance
   ( EraTxOut era
   , NFData (GovState era)
@@ -403,6 +413,11 @@ data NewEpochState era = NewEpochState
   }
   deriving (Generic)
 
+instance CanGetUTxO NewEpochState
+instance CanSetUTxO NewEpochState where
+  utxoL = (lens nesEs $ \s es -> s {nesEs = es}) . utxoL
+  {-# INLINE utxoL #-}
+
 type family StashedAVVMAddresses era where
   StashedAVVMAddresses ShelleyEra = UTxO ShelleyEra
   StashedAVVMAddresses _ = ()
@@ -490,6 +505,11 @@ data LedgerState era = LedgerState
   }
   deriving (Generic)
 
+instance CanGetUTxO LedgerState
+instance CanSetUTxO LedgerState where
+  utxoL = (lens lsUTxOState $ \s us -> s {lsUTxOState = us}) . utxoL
+  {-# INLINE utxoL #-}
+
 deriving stock instance
   ( EraTxOut era
   , Show (GovState era)
@@ -664,6 +684,7 @@ lsCertStateL = lens lsCertState (\x y -> x {lsCertState = y})
 
 utxosUtxoL :: Lens' (UTxOState era) (UTxO era)
 utxosUtxoL = lens utxosUtxo (\x y -> x {utxosUtxo = y})
+{-# DEPRECATED utxosUtxoL "In favor of `utxoL`" #-}
 
 utxosDepositedL :: Lens' (UTxOState era) Coin
 utxosDepositedL = lens utxosDeposited (\x y -> x {utxosDeposited = y})

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

@@ -80,7 +80,7 @@ import Cardano.Ledger.Shelley.TxBody (RewardAccount)
 import Cardano.Ledger.Shelley.UTxO (consumed, produced)
 import Cardano.Ledger.Slot (SlotNo)
 import Cardano.Ledger.TxIn (TxIn)
-import Cardano.Ledger.UTxO (EraUTxO (getMinFeeTxUtxo), UTxO (..), balance, txouts)
+import Cardano.Ledger.UTxO (CanSetUTxO (..), EraUTxO (getMinFeeTxUtxo), UTxO (..), balance, txouts)
 import Cardano.Ledger.Val ((<->))
 import qualified Cardano.Ledger.Val as Val
 import Control.DeepSeq
@@ -360,7 +360,8 @@ utxoInductive ::
   TransitionRule (EraRule "UTXO" era)
 utxoInductive = do
   TRC (UtxoEnv slot pp certState, utxos, tx) <- judgmentContext
-  let UTxOState utxo _ _ ppup _ _ = utxos
+  let utxo = utxos ^. utxoL
+      UTxOState _ _ _ ppup _ _ = utxos
       txBody = tx ^. bodyTxL
       outputs = txBody ^. outputsTxBodyL
       genDelegs = dsGenDelegs (certDState certState)

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -169,6 +169,7 @@ import Cardano.Ledger.Shelley.Genesis (
   validateGenesis,
  )
 import Cardano.Ledger.Shelley.LedgerState (
+  CanSetUTxO (..),
   LedgerState (..),
   NewEpochState (..),
   StashedAVVMAddresses,
@@ -186,7 +187,6 @@ import Cardano.Ledger.Shelley.LedgerState (
   prevPParamsEpochStateL,
   produced,
   utxosDonationL,
-  utxosUtxoL,
  )
 import Cardano.Ledger.Shelley.Rules (
   BbodyEnv (..),
@@ -584,8 +584,7 @@ defaultInitImpTestState nes = do
     rootCoin = Coin (toInteger (sgMaxLovelaceSupply shelleyGenesis))
     rootTxIn :: TxIn
     rootTxIn = TxIn (mkTxId 0) minBound
-    nesWithRoot =
-      nes & nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL <>~ UTxO (Map.singleton rootTxIn rootTxOut)
+    nesWithRoot = nes & utxoL <>~ UTxO (Map.singleton rootTxIn rootTxOut)
   prepState <- get
   let epochInfoE =
         fixedEpochInfo
@@ -779,7 +778,7 @@ impWitsVKeyNeeded txBody = do
       bootAddrs = Set.fromList $ mapMaybe toBootAddr $ Set.toList (txBody ^. spendableInputsTxBodyF)
       bootKeyHashes = Set.map (coerceKeyRole . bootstrapKeyHash) bootAddrs
       allKeyHashes =
-        getWitsVKeyNeeded (ls ^. lsCertStateL) (ls ^. lsUTxOStateL . utxosUtxoL) txBody
+        getWitsVKeyNeeded (ls ^. lsCertStateL) (ls ^. utxoL) txBody
   pure (bootAddrs, allKeyHashes Set.\\ bootKeyHashes)
 
 data ImpTestEnv era = ImpTestEnv
@@ -1046,7 +1045,7 @@ shelleyFixupTx =
 logFeeMismatch :: (EraGov era, EraUTxO era, HasCallStack) => Tx era -> ImpTestM era ()
 logFeeMismatch tx = do
   pp <- getsNES $ nesEsL . curPParamsEpochStateL
-  utxo <- getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+  utxo <- getsNES utxoL
   let Coin feeUsed = tx ^. bodyTxL . feeTxBodyL
       Coin feeMin = getMinFeeTxUtxo pp tx utxo
   when (feeUsed /= feeMin) $ do
@@ -1442,7 +1441,7 @@ getsNES :: SimpleGetter (NewEpochState era) a -> ImpTestM era a
 getsNES l = gets . view $ impNESL . l
 
 getUTxO :: ImpTestM era (UTxO era)
-getUTxO = getsNES $ nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL
+getUTxO = getsNES utxoL
 
 getProtVer :: EraGov era => ImpTestM era ProtVer
 getProtVer = getsNES $ nesEsL . curPParamsEpochStateL . ppProtocolVersionL

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

@@ -15,7 +15,6 @@ import Cardano.Ledger.Block (Block)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
-import Cardano.Ledger.UTxO (UTxO (..))
 import Cardano.Protocol.TPraos.BHeader (BHeader)
 import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
 import Data.Default

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

@@ -29,7 +29,6 @@ import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
 import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits, addrWits)
 import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
 import Cardano.Ledger.TxIn (TxIn (..))
-import Cardano.Ledger.UTxO (UTxO (..))
 import Cardano.Ledger.Val ((<->))
 import qualified Cardano.Ledger.Val as Val
 import Cardano.Protocol.Crypto (hashVerKeyVRF)

libs/cardano-ledger-conformance/test/Test/Cardano/Ledger/Conformance/Imp.hs

@@ -84,7 +84,7 @@ testImpConformance _globals impRuleResult env state signal = do
           , clecUtxoExecContext =
               UtxoExecContext
                 { uecTx = signal
-                , uecUTxO = state ^. lsUTxOStateL . utxosUtxoL
+                , uecUTxO = state ^. utxoL
                 , uecUtxoEnv =
                     UtxoEnv
                       { ueSlot = env ^. ledgerSlotNoL

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## 1.17.0.0
 
+* Add `CanGetUTxO` and `CanSetUTxO` type classes
+* Add `CanGetUTxO` and `CanSetUTxO` instances for `UTxO` 
 * Add `DecShareCBOR` instances for `DRep` and `DRepState`
 * Added `ToPlutusData` instance for `NonZero`
 * `maxpool'` now expects `nOpt` to be a `NonZero Word16`

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -16,6 +17,9 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
 
 module Cardano.Ledger.UTxO (
+  CanGetUTxO (..),
+  CanSetUTxO (..),
+
   -- * Primitives
   UTxO (..),
   EraUTxO (..),
@@ -67,12 +71,25 @@ import Data.Monoid (Sum (..))
 import Data.Set (Set)
 import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
-import Lens.Micro ((^.))
+import Lens.Micro (Lens', SimpleGetter, (^.))
 import NoThunks.Class (NoThunks (..))
 import Quiet (Quiet (Quiet))
 
 -- ===============================================
 
+class CanGetUTxO t where
+  utxoG :: SimpleGetter (t era) (UTxO era)
+  default utxoG :: CanSetUTxO t => SimpleGetter (t era) (UTxO era)
+  utxoG = utxoL
+  {-# INLINE utxoG #-}
+
+class CanGetUTxO t => CanSetUTxO t where
+  utxoL :: Lens' (t era) (UTxO era)
+
+instance CanGetUTxO UTxO
+instance CanSetUTxO UTxO where
+  utxoL = id
+
 -- | The unspent transaction outputs.
 newtype UTxO era = UTxO {unUTxO :: Map.Map TxIn (TxOut era)}
   deriving (Default, Generic, Semigroup)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/Ledger.hs

@@ -124,7 +124,6 @@ import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut (..))
 import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (..))
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import Cardano.Ledger.UMap
-import Cardano.Ledger.UTxO
 import Cardano.Ledger.Val (Val)
 import Constrained hiding (Sized, Value)
 import Constrained qualified as C

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/LedgerTypes/WellFormed.hs

@@ -29,7 +29,6 @@ import Cardano.Ledger.EpochBoundary (SnapShot (..), SnapShots (..))
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
 import Cardano.Ledger.PoolParams (PoolParams (..))
 import Cardano.Ledger.Shelley.LedgerState
-import Cardano.Ledger.UTxO (UTxO (..))
 import Constrained hiding (Value)
 import Data.Map (Map)
 import Test.Cardano.Ledger.Constrained.Conway ()

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Lenses.hs

@@ -30,7 +30,6 @@ import Cardano.Ledger.UMap (
   unify,
  )
 import qualified Cardano.Ledger.UMap as UM
-import Cardano.Ledger.UTxO (UTxO (..))
 import Data.Foldable (Foldable (..))
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs

@@ -101,7 +101,6 @@ import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert (..))
 import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
 import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
 import qualified Cardano.Ledger.UMap as UM
-import Cardano.Ledger.UTxO (UTxO (..))
 import Cardano.Ledger.Val (Val ((<+>)))
 import Control.Monad.Identity (Identity)
 import Data.ByteString (ByteString)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs

@@ -102,7 +102,6 @@ import Cardano.Ledger.Shelley.TxBody (RewardAccount (..))
 import Cardano.Ledger.Shelley.UTxO (EraUTxO (..), ShelleyScriptsNeeded (..))
 import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Ledger.UMap (compactCoinOrError, fromCompact, ptrMap, rdPairMap, sPoolMap, unify)
-import Cardano.Ledger.UTxO (UTxO (..))
 import Cardano.Ledger.Val (Val (..))
 import Control.Arrow (first)
 import Data.Default (Default (def))
@@ -358,10 +357,10 @@ numDormantEpochsL = nesEsL . esLStateL . lsCertStateL . certVStateL . vsNumDorma
 -- UTxOState
 
 utxo :: Era era => Proof era -> Term era (Map TxIn (TxOutF era))
-utxo p = Var $ pV p "utxo" (MapR TxInR (TxOutR p)) (Yes NewEpochStateR (utxoL p))
+utxo p = Var $ pV p "utxo" (MapR TxInR (TxOutR p)) (Yes NewEpochStateR (utxoL' p))
 
-utxoL :: Proof era -> NELens era (Map TxIn (TxOutF era))
-utxoL proof = nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL . unUtxoL proof
+utxoL' :: Proof era -> NELens era (Map TxIn (TxOutF era))
+utxoL' proof = utxoL . unUtxoL proof
 
 unUtxoL :: Proof era -> Lens' (UTxO era) (Map TxIn (TxOutF era))
 unUtxoL p = lens (Map.map (TxOutF p) . unUTxO) (\(UTxO _) new -> liftUTxO new)
@@ -1027,7 +1026,7 @@ utxoStateT ::
   forall era. Gov.EraGov era => Proof era -> RootTarget era (UTxOState era) (UTxOState era)
 utxoStateT p =
   Invert "UTxOState" (typeRep @(UTxOState era)) (unReflect utxofun p)
-    :$ Lensed (utxo p) (utxosUtxoL . unUtxoL p)
+    :$ Lensed (utxo p) (utxoL . unUtxoL p)
     :$ Lensed deposits utxosDepositedL
     :$ Lensed fees utxosFeesL
     :$ Shift (govStateT p) (utxosGovStateL . unGovL p)

libs/ledger-state/src/Cardano/Ledger/State/Query.hs

@@ -25,7 +25,6 @@ import Cardano.Ledger.State.Vector
 import qualified Cardano.Ledger.TxIn as TxIn
 import Cardano.Ledger.UMap (ptrMap, rewardMap, sPoolMap, unify)
 import qualified Cardano.Ledger.UMap as UM
-import qualified Cardano.Ledger.UTxO as Shelley
 import Conduit
 import Control.Foldl (Fold (..))
 import Control.Monad