PLT-5775: plutus-ledger refactoring (#1091)

* Remove plutus-script-utils dep

* Remove Ledger.Tokens

* Clean up plutus-ledger

* Changelog

cardano-node-emulator/cardano-node-emulator.cabal

@@ -45,9 +45,8 @@ library
   -- Local components
   --------------------
   build-depends:
-    , freer-extras         >=1.2.0
-    , plutus-ledger        >=1.2.0
-    , plutus-script-utils  >=1.2.0
+    , freer-extras   >=1.2.0
+    , plutus-ledger  >=1.2.0
 
   --------------------------
   -- Other IOG dependencies

cardano-node-emulator/src/Cardano/Node/Emulator/API.hs

@@ -48,7 +48,7 @@ import Cardano.Api.Shelley qualified as C
 import Cardano.Node.Emulator.Internal.API (EmulatorError (BalancingError, ToCardanoError, ValidationError),
                                            EmulatorLogs, EmulatorM, EmulatorState (EmulatorState), EmulatorT,
                                            MonadEmulator, esAddressMap, esChainState, esDatumMap, handleChain)
-import Control.Lens (view, (%~), (&), (<>~), (^.))
+import Control.Lens ((%~), (&), (<>~), (^.))
 import Control.Monad (void)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Freer.Extras.Log qualified as L
@@ -60,8 +60,8 @@ import Ledger (CardanoAddress, CardanoTx (CardanoEmulatorEraTx), Datum, DatumHas
                PaymentPrivateKey (unPaymentPrivateKey), Slot, TxOutRef, UtxoIndex)
 import Ledger.AddressMap qualified as AM
 import Ledger.Index (createGenesisTransaction, insertBlock)
-import Ledger.Tx (TxOut, addCardanoTxSignature, cardanoTxOutValue, decoratedTxOutValue, getCardanoTxData,
-                  getCardanoTxId, toCtxUTxOTxOut, toDecoratedTxOut)
+import Ledger.Tx (TxOut, addCardanoTxSignature, cardanoTxOutValue, getCardanoTxData, getCardanoTxId, toCtxUTxOTxOut,
+                  toDecoratedTxOut)
 import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), fromCardanoTxIn, toCardanoTxIn, toCardanoTxOutValue)
 
 import Cardano.Node.Emulator.Generators qualified as G
@@ -130,15 +130,15 @@ utxosAtPlutus addr = do
 utxoAtTxOutRef :: MonadEmulator m => C.TxIn -> m (Maybe TxOut)
 utxoAtTxOutRef txIn = do
   es <- get
-  pure $ snd <$> Map.lookup txIn (AM.outRefMap (es ^. esAddressMap))
+  pure $ AM.lookupOutRef txIn (es ^. esAddressMap)
 
 -- | Resolve the transaction output reference (using Plutus types).
 utxoAtTxOutRefPlutus :: MonadEmulator m => TxOutRef -> m (Maybe DecoratedTxOut)
 utxoAtTxOutRefPlutus ref = either (const $ pure Nothing) findTxOut (toCardanoTxIn ref)
   where
     findTxOut txIn = do
       es <- get
-      let mTxOut = snd <$> Map.lookup txIn (AM.outRefMap (es ^. esAddressMap))
+      let mTxOut = AM.lookupOutRef txIn (es ^. esAddressMap)
       pure $ mTxOut >>= toDecoratedTxOut
 
 -- | Query the total value of the unspent transaction outputs at the given address.

cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs

@@ -42,7 +42,6 @@ module Cardano.Node.Emulator.Generators(
     genValue,
     genValueNonNegative,
     genSizedByteString,
-    genSizedByteStringExact,
     genSeed,
     genPassphrase,
     splitVal,
@@ -90,15 +89,14 @@ import Hedgehog.Range qualified as Range
 import Ledger (CardanoTx (CardanoEmulatorEraTx), Interval, MintingPolicy (getMintingPolicy),
                POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase),
                PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange, TxOut,
-               ValidationErrorInPhase, addCardanoTxSignature, createGenesisTransaction, maxFee, minAdaTxOutEstimated,
-               minLovelaceTxOutEstimated, pubKeyAddress, pubKeyTxOut, txOutValue)
+               ValidationErrorInPhase, addCardanoTxSignature, createGenesisTransaction, minLovelaceTxOutEstimated,
+               pubKeyAddress, pubKeyTxOut, txOutValue)
 import Ledger.CardanoWallet qualified as CW
 import Ledger.Tx qualified as Tx
 import Ledger.Tx.CardanoAPI (fromCardanoPlutusScript, fromPlutusIndex)
 import Ledger.Tx.CardanoAPI qualified as C hiding (makeTransactionBody)
 import Ledger.Value.CardanoAPI qualified as Value
 import Numeric.Natural (Natural)
-import Plutus.Script.Utils.Ada qualified as Ada
 import Plutus.V1.Ledger.Interval qualified as Interval
 import Plutus.V1.Ledger.Scripts qualified as Script
 import PlutusTx (toData)
@@ -346,12 +344,6 @@ genSizedByteString s =
     let range = Range.linear 0 s
     in Gen.bytes range
 
--- | Generate a 'ByteString s' of exactly @s@ bytes.
-genSizedByteStringExact :: forall m. MonadGen m => Int -> m BS.ByteString
-genSizedByteStringExact s =
-    let range = Range.singleton s
-    in Gen.bytes range
-
 -- Copied from Gen.Cardano.Api.Typed, because it's not exported.
 genPolicyId :: Gen C.PolicyId
 genPolicyId =
@@ -420,7 +412,7 @@ splitVal mx init' = go 0 0 [] where
             if v + c == init'
             then pure $ v : l
             else go (succ i) (v + c) (v : l)
-    minAda = fromIntegral $ Ada.getLovelace $ Ledger.minAdaTxOutEstimated + Ledger.maxFee
+    minAda = 3_000_000 -- For fee and min Ada for tx outs
 
 knownXPrvs :: [Crypto.XPrv]
 knownXPrvs = unPaymentPrivateKey <$> CW.knownPaymentPrivateKeys

cardano-node-emulator/src/Cardano/Node/Emulator/Internal/Node/Chain.hs

@@ -26,11 +26,10 @@ import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logInfo, logWarn)
 import Control.Monad.Freer.State (State, gets, modify)
 import Control.Monad.State qualified as S
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Either (fromRight)
 import Data.Foldable (traverse_)
 import Data.List ((\\))
 import Data.Map qualified as Map
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Monoid (Ap (Ap))
 import Data.Text (Text)
 import Data.Traversable (for)
@@ -180,7 +179,7 @@ validateBlock params slot@(Slot s) idx txns =
 getCollateral :: Index.UtxoIndex -> CardanoTx -> C.Value
 getCollateral idx tx = case getCardanoTxTotalCollateral tx of
     Just v -> lovelaceToValue v
-    Nothing -> fromRight (lovelaceToValue $ getCardanoTxFee tx) $
+    Nothing -> fromMaybe (lovelaceToValue $ getCardanoTxFee tx) $
         alaf Ap foldMap (fmap txOutValue . (`Index.lookup` idx)) (getCardanoTxCollateralInputs tx)
 
 -- | Check whether the given transaction can be validated in the given slot.

cardano-node-emulator/test/Cardano/Node/Emulator/GeneratorsSpec.hs

@@ -22,8 +22,7 @@ import Ledger qualified
 import Ledger.Bytes qualified as Bytes
 import Ledger.Interval qualified as Interval
 import Ledger.Value.CardanoAPI qualified as C
-import Plutus.Script.Utils.Ada qualified as Ada
-import Plutus.Script.Utils.Value qualified as Value
+import Plutus.V1.Ledger.Value qualified as Value
 import PlutusTx.Prelude qualified as PlutusTx
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Hedgehog (testPropertyNamed)
@@ -50,8 +49,6 @@ tests = testGroup "Cardano.Node.Emulator.Generators" [
   ],
   testGroup "Value" [
     testPropertyNamed "Value ToJSON/FromJSON" "value_json_roundtrip" (jsonRoundTrip Gen.genValue),
-    testPropertyNamed "CurrencySymbol ToJSON/FromJSON" "currency_symbol_json_roundtrip" (jsonRoundTrip $ Value.currencySymbol <$> Gen.genSizedByteStringExact 32),
-    testPropertyNamed "CurrencySymbol IsString/Show" "currencySymbolIsStringShow" currencySymbolIsStringShow,
     testPropertyNamed "Old split equals the new split" "valueSplit" valueSplit
   ],
   testGroup "TimeSlot" [
@@ -86,7 +83,7 @@ splitVal = property $ do
 
 splitValMinAda :: Property
 splitValMinAda = property $ do
-    let minAda = Ada.getLovelace $ Ledger.minAdaTxOutEstimated + Ledger.maxFee
+    let minAda = 3_000_000
     i <- forAll $ Gen.integral $ Range.linear minAda (100_000_000 :: Integer)
     n <- forAll $ Gen.integral $ Range.linear 1 100
     vs <- forAll $ Gen.splitVal n i
@@ -107,12 +104,6 @@ ledgerBytesToJSONProp = property $ do
 
     Hedgehog.assert $ result == Aeson.ISuccess bts
 
-currencySymbolIsStringShow :: Property
-currencySymbolIsStringShow = property $ do
-    cs <- forAll $ Value.currencySymbol <$> Gen.genSizedByteStringExact 32
-    let cs' = fromString (show cs)
-    Hedgehog.assert $ cs' == cs
-
 valueAddIdentity :: Property
 valueAddIdentity = property $ do
     vl1 <- forAll Gen.genValue

plutus-contract/src/Wallet/Emulator/MultiAgent.hs

@@ -38,7 +38,7 @@ import Data.Maybe (fromMaybe, isNothing)
 import Data.Text qualified as T
 import Data.Text.Extras (tshow)
 import GHC.Generics (Generic)
-import Ledger hiding (to, value)
+import Ledger hiding (to)
 import Ledger.AddressMap qualified as AM
 import Ledger.Index qualified as Index
 import Ledger.Tx qualified as Tx

plutus-contract/src/Wallet/Graph.hs

@@ -29,6 +29,7 @@ import Ledger.Address
 import Ledger.Blockchain
 import Ledger.Credential (Credential (..))
 import Ledger.Crypto
+import Ledger.Index qualified as Index
 import Ledger.Tx
 
 -- | The owner of an unspent transaction output.
@@ -103,7 +104,8 @@ txnFlows keys bc = catMaybes (utxoLinks ++ foldMap extract bc')
     knownKeys :: Set.Set PubKey
     knownKeys = Set.fromList keys
 
-    utxos = Map.keys $ C.unUTxO $ unspentOutputs bc
+    index = Index.initialise bc
+    utxos = Map.keys $ C.unUTxO index
     utxoLinks = uncurry (flow Nothing) <$> zip (utxoTargets <$> utxos) utxos
 
     extract :: (UtxoLocation, OnChainTx) -> [Maybe FlowLink]
@@ -114,7 +116,7 @@ txnFlows keys bc = catMaybes (utxoLinks ++ foldMap extract bc')
 
     flow :: Maybe UtxoLocation -> TxRef -> C.TxIn -> Maybe FlowLink
     flow tgtLoc tgtRef rf@(C.TxIn txId _) = do
-      src <- out bc rf
+      src <- Index.lookup rf index
       sourceLoc <- Map.lookup rf sourceLocations
       let sourceRef = mkRef txId
       pure FlowLink

plutus-contract/test/Spec/Emulator.hs

@@ -29,7 +29,7 @@ import Hedgehog (Property, forAll, property)
 import Hedgehog qualified
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
-import Ledger (CardanoTx (..), OnChainTx (Valid), PaymentPubKeyHash, toCtxUTxOTxOut, unspentOutputs)
+import Ledger (CardanoTx (..), OnChainTx (Valid), PaymentPubKeyHash, toCtxUTxOTxOut)
 import Ledger.Index qualified as Index
 import Ledger.Value.CardanoAPI qualified as Value
 import Plutus.Contract.Test hiding (not)
@@ -112,7 +112,7 @@ pubKey3 = mockWalletPaymentPubKeyHash wallet3
 utxo :: Property
 utxo = property $ do
     Mockchain txPool o _params <- forAll Gen.genMockchain
-    Hedgehog.assert (unspentOutputs [map Valid txPool] == C.UTxO (fmap toCtxUTxOTxOut o))
+    Hedgehog.assert (Index.initialise [map Valid txPool] == C.UTxO (fmap toCtxUTxOTxOut o))
 
 txnValid :: Property
 txnValid = property $ do

plutus-ledger/changelog.d/20230623_134342_sjoerd.visscher_PLT_5775_plutus-ledger_refactoring.md

@@ -0,0 +1,4 @@
+### Removed
+
+- Removed `Ledger.Tokens`
+- Removed lots of functions from `Ledger.AddressMap` and `Ledger.Blockchain`.

plutus-ledger/plutus-ledger.cabal

@@ -75,7 +75,6 @@ library
     Ledger.Scripts.Orphans
     Ledger.Slot
     Ledger.Test
-    Ledger.Tokens
     Ledger.Tx
     Ledger.Tx.CardanoAPI
     Ledger.Tx.CardanoAPI.Internal

plutus-ledger/src/Ledger/AddressMap.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia   #-}
 {-# LANGUAGE Rank2Types    #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies  #-}
 -- | 'AddressMap's and functions for working on them.
 --
@@ -13,30 +12,25 @@ module Ledger.AddressMap(
     UtxoMap,
     addAddress,
     addAddresses,
-    filterRefs,
     fundsAt,
     values,
     traverseWithKey,
     singleton,
-    fromTxOutputs,
-    knownAddresses,
     updateAddresses,
     updateAllAddresses,
-    restrict,
-    addressesTouched,
-    outRefMap,
-    outputsMapFromTxForAddress,
+    lookupOutRef,
     fromChain
     ) where
 
 import Codec.Serialise.Class (Serialise)
-import Control.Lens (At (..), Index, IxValue, Ixed (..), Lens', at, lens, non, (&), (.~), (^.))
+import Control.Lens (At (..), Index, IxValue, Ixed (..), Lens', alaf, at, lens, non, (&), (.~), (^.))
 import Control.Monad (join)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Foldable (fold)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
+import Data.Monoid (First (..))
 import Data.Set qualified as Set
 import GHC.Generics (Generic)
 
@@ -57,13 +51,9 @@ newtype AddressMap = AddressMap { getAddressMap :: Map CardanoAddress UtxoMap }
 singleton :: (CardanoAddress, C.TxIn, CardanoTx, TxOut) -> AddressMap
 singleton (addr, ref, tx, ot) = AddressMap $ Map.singleton addr (Map.singleton ref (tx, ot))
 
-outRefMap :: AddressMap -> Map C.TxIn (CardanoTx, TxOut)
-outRefMap (AddressMap am) = Map.unions (snd <$> Map.toList am)
-
--- | Filter the transaction output references in the map
-filterRefs :: (C.TxIn -> (CardanoTx, TxOut) -> Bool) -> AddressMap -> AddressMap
-filterRefs flt =
-    AddressMap . Map.map (Map.filterWithKey flt) . getAddressMap
+-- | Determine the unspent output that an input refers to
+lookupOutRef :: C.TxIn -> AddressMap -> Maybe TxOut
+lookupOutRef outRef = fmap snd . alaf First foldMap (Map.lookup outRef) . getAddressMap
 
 instance Semigroup AddressMap where
     (AddressMap l) <> (AddressMap r) = AddressMap (Map.unionWith add l r) where
@@ -111,12 +101,6 @@ traverseWithKey ::
   -> f AddressMap
 traverseWithKey f (AddressMap m) = AddressMap <$> Map.traverseWithKey f m
 
-outputsMapFromTxForAddress :: CardanoAddress -> OnChainTx -> Map C.TxIn (CardanoTx, TxOut)
-outputsMapFromTxForAddress addr tx =
-    fmap (unOnChain tx ,)
-    $ Map.filter ((==) addr . txOutAddress)
-    $ outputsProduced tx
-
 -- | Create an 'AddressMap' with the unspent outputs of a single transaction.
 fromTxOutputs :: OnChainTx -> AddressMap
 fromTxOutputs tx =
@@ -140,15 +124,15 @@ updateAddresses tx utxo = AddressMap $ Map.mapWithKey upd (getAddressMap utxo) w
     -- adds the newly produced outputs, and removes the consumed outputs, for
     -- an address `adr`
     upd :: CardanoAddress -> Map C.TxIn (CardanoTx, TxOut) -> Map C.TxIn (CardanoTx, TxOut)
-    upd adr mp = Map.union (producedAt adr) mp `Map.difference` consumedFrom adr
+    upd adr mp = Map.union (producedAt adr) mp `Map.withoutKeys` consumedFrom adr
 
     -- The TxOutRefs produced by the transaction, for a given address
     producedAt :: CardanoAddress -> Map C.TxIn (CardanoTx, TxOut)
-    producedAt adr = Map.findWithDefault Map.empty adr outputs
+    producedAt adr = Map.findWithDefault mempty adr outputs
 
     -- The TxOutRefs consumed by the transaction, for a given address
-    consumedFrom :: CardanoAddress -> Map C.TxIn ()
-    consumedFrom adr = maybe Map.empty (Map.fromSet (const ())) $ Map.lookup adr consumedInputs
+    consumedFrom :: CardanoAddress -> Set.Set C.TxIn
+    consumedFrom adr = Map.findWithDefault mempty adr consumedInputs
 
     AddressMap outputs = fromTxOutputs tx
 
@@ -173,20 +157,9 @@ inputs addrs = Map.fromListWith Set.union
     . mapMaybe (\a -> sequence (a, Map.lookup a addrs))
     . consumableInputs
 
--- | Restrict an 'AddressMap' to a set of addresses.
-restrict :: AddressMap -> Set.Set CardanoAddress -> AddressMap
-restrict (AddressMap mp) = AddressMap . Map.restrictKeys mp
-
 swap :: (a, b) -> (b, a)
 swap (x, y) = (y, x)
 
--- | Get the set of all addresses that the transaction spends outputs from
---   or produces outputs to
-addressesTouched :: AddressMap -> OnChainTx -> Set.Set CardanoAddress
-addressesTouched utxo t = ins <> outs where
-    ins = Map.keysSet (inputs (knownAddresses utxo) t)
-    outs = Map.keysSet (getAddressMap (fromTxOutputs t))
-
 -- | The unspent transaction outputs of the ledger as a whole.
 fromChain :: Blockchain -> AddressMap
 fromChain = foldr updateAllAddresses mempty . join