Use Data backed ledger types for COOP

plutus-benchmark/coop/src/PlutusBenchmark/Coop/Gen.hs

@@ -24,15 +24,16 @@ import Data.Map qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Traversable (for)
-import PlutusLedgerApi.V1.Address (pubKeyHashAddress, scriptHashAddress)
-import PlutusLedgerApi.V1.Value
-import PlutusLedgerApi.V2 hiding (Map)
-import PlutusTx.AssocMap qualified as AssocMap
+import PlutusLedgerApi.Data.V2 hiding (Map)
+import PlutusLedgerApi.V1.Data.Address (pubKeyHashAddress, scriptHashAddress)
+import PlutusLedgerApi.V1.Data.Value
 import PlutusTx.Builtins.HasOpaque (stringToBuiltinByteString)
+import PlutusTx.Data.AssocMap qualified as AssocMap
+import PlutusTx.Data.List qualified as Li
 
 import PlutusBenchmark.Coop.Types
-import PlutusLedgerApi.V1.Interval (interval)
-import PlutusLedgerApi.V2 qualified as Value
+import PlutusLedgerApi.Data.V2 qualified as Value
+import PlutusLedgerApi.V1.Data.Interval (interval)
 import PlutusTx.Prelude (Group (inv))
 
 mkScriptContext :: ScriptPurpose -> [TxInInfo] -> [TxInInfo] -> Value -> [TxOut] -> [PubKeyHash] -> ScriptContext
@@ -49,11 +50,11 @@ mkTxInfo ins refs mints outs sigs =
     , txInfoData = AssocMap.empty
     , txInfoId = ""
     , txInfoRedeemers = AssocMap.empty
-    , txInfoInputs = sortOn (\(TxInInfo i _) -> i) ins
-    , txInfoReferenceInputs = sortOn (\(TxInInfo i _) -> i) refs
+    , txInfoInputs = Li.fromSOP $ sortOn (\(TxInInfo i _) -> i) ins
+    , txInfoReferenceInputs = Li.fromSOP $ sortOn (\(TxInInfo i _) -> i) refs
     , txInfoMint = normalizeValue mints
-    , txInfoOutputs = outs
-    , txInfoSignatories = sigs
+    , txInfoOutputs = Li.fromSOP outs
+    , txInfoSignatories = Li.fromSOP sigs
     }
 
 setValidity :: ScriptContext -> Value.POSIXTimeRange -> ScriptContext
@@ -413,14 +414,14 @@ genCorrectFsMpBurningCtx fsMpParams fsCs = do
   fsMintCtx <- genCorrectFsMpMintingCtx fsMpParams fsCs
   (otherIns, otherMint, otherOuts) <- genOthers 5
 
-  let fsVOuts = [out | out <- txInfoOutputs . scriptContextTxInfo $ fsMintCtx, txOutAddress out == fsVAddr]
+  let fsVOuts = Li.fromSOP [out | out <- Li.toSOP (txInfoOutputs . scriptContextTxInfo $ fsMintCtx), txOutAddress out == fsVAddr]
 
-  fsIns <- for fsVOuts (\fsOut -> TxInInfo <$> genTxOutRef <*> pure fsOut)
+  fsIns <- for (Li.toSOP fsVOuts) (\fsOut -> TxInInfo <$> genTxOutRef <*> pure fsOut)
 
-  let fsDatums = [fsDat | out <- fsVOuts, OutputDatum (Datum dat) <- [txOutDatum out], fsDat <- maybe [] pure (fromBuiltinData @FsDatum dat)]
-      gcAfter = maximum [fs'gcAfter fsDatum | fsDatum <- fsDatums]
-      submitters = [fs'submitter fsDatum | fsDatum <- fsDatums]
-      fsBurned = mconcat [inv $ txOutValue fsVOut | fsVOut <- fsVOuts]
+  let fsDatums = Li.fromSOP [fsDat | out <- Li.toSOP fsVOuts, OutputDatum (Datum dat) <- [txOutDatum out], fsDat <- maybe [] pure (fromBuiltinData @FsDatum dat)]
+      gcAfter = maximum [fs'gcAfter fsDatum | fsDatum <- Li.toSOP fsDatums]
+      submitters = [fs'submitter fsDatum | fsDatum <- Li.toSOP fsDatums]
+      fsBurned = mconcat [inv $ txOutValue fsVOut | fsVOut <- Li.toSOP fsVOuts]
       ins = otherIns <> fsIns
       mint = otherMint <> fsBurned
       outs = otherOuts
@@ -609,8 +610,8 @@ doMintAndPayOtherTokenName cs ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoMint = txInfoMint txInfo <> assetClassValue otherAc (toInteger . length . txInfoOutputs $ txInfo)
-              , txInfoOutputs = txInfoOutputs txInfo <> [out {txOutValue = assetClassValue otherAc 1 <> txOutValue out} | out <- txInfoOutputs txInfo]
+              { txInfoMint = txInfoMint txInfo <> assetClassValue otherAc (Li.length . txInfoOutputs $ txInfo)
+              , txInfoOutputs = txInfoOutputs txInfo <> Li.fromSOP [out {txOutValue = assetClassValue otherAc 1 <> txOutValue out} | out <- Li.toSOP (txInfoOutputs txInfo)]
               }
         }
 
@@ -623,7 +624,7 @@ doMintAndPayOtherTokenNameAddr cs addr ctx =
         { scriptContextTxInfo =
             txInfo
               { txInfoMint = txInfoMint txInfo <> assetClassValue otherAc 1
-              , txInfoOutputs = txInfoOutputs txInfo <> [TxOut addr (assetClassValue otherAc 1) NoOutputDatum Nothing]
+              , txInfoOutputs = txInfoOutputs txInfo <> Li.fromSOP [TxOut addr (assetClassValue otherAc 1) NoOutputDatum Nothing]
               }
         }
 
@@ -634,7 +635,7 @@ doRemoveOutputDatum ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoOutputs = [out {txOutDatum = NoOutputDatum} | out <- txInfoOutputs txInfo]
+              { txInfoOutputs = Li.fromSOP [out {txOutDatum = NoOutputDatum} | out <- Li.toSOP (txInfoOutputs txInfo)]
               }
         }
 
@@ -645,7 +646,7 @@ doPayToOtherAddress originalAddr otherAddr ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoOutputs = [out {txOutAddress = otherAddr} | out <- txInfoOutputs txInfo, txOutAddress out == originalAddr]
+              { txInfoOutputs = Li.fromSOP [out {txOutAddress = otherAddr} | out <- Li.toSOP (txInfoOutputs txInfo), txOutAddress out == originalAddr]
               }
         }
 
@@ -656,7 +657,7 @@ doRemoveInputsWithToken ac ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoInputs = [inp | inp@(TxInInfo _ inOut) <- txInfoInputs txInfo, assetClassValueOf (txOutValue inOut) ac > 0]
+              { txInfoInputs = Li.fromSOP [inp | inp@(TxInInfo _ inOut) <- Li.toSOP (txInfoInputs txInfo), assetClassValueOf (txOutValue inOut) ac > 0]
               }
         }
 
@@ -667,7 +668,7 @@ doRemoveRefInputsWithCurrency cs ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoReferenceInputs = [inp | inp@(TxInInfo _ inOut) <- txInfoReferenceInputs txInfo, not . AssocMap.member cs $ getValue (txOutValue inOut)]
+              { txInfoReferenceInputs = Li.fromSOP [inp | inp@(TxInInfo _ inOut) <- Li.toSOP (txInfoReferenceInputs txInfo), not . AssocMap.member cs $ getValue (txOutValue inOut)]
               }
         }
 
@@ -678,7 +679,7 @@ doRemoveInputsWithCurrency cs ctx =
    in ctx
         { scriptContextTxInfo =
             txInfo
-              { txInfoInputs = [inp | inp@(TxInInfo _ inOut) <- txInfoInputs txInfo, not . AssocMap.member cs $ getValue (txOutValue inOut)]
+              { txInfoInputs = Li.fromSOP [inp | inp@(TxInInfo _ inOut) <- Li.toSOP (txInfoInputs txInfo), not . AssocMap.member cs $ getValue (txOutValue inOut)]
               }
         }
 
@@ -692,7 +693,7 @@ doPayInsteadOfBurn addr ctx =
         { scriptContextTxInfo =
             txInfo
               { txInfoMint = mintedVal
-              , txInfoOutputs = txInfoOutputs txInfo <> [TxOut addr (inv burnedVal) NoOutputDatum Nothing]
+              , txInfoOutputs = txInfoOutputs txInfo <> (Li.singleton $ TxOut addr (inv burnedVal) NoOutputDatum Nothing)
               }
         }
 
@@ -724,17 +725,17 @@ _doNothing = id
 -- TODO: Switch to mlabs-haskell/plutus-simple-model (that's why you need it)
 normalizeValue :: Value -> Value
 normalizeValue v =
-  Value . AssocMap.safeFromList . Map.toList . (AssocMap.safeFromList . Map.toList <$>) $
+  Value . AssocMap.safeFromSOPList . Map.toList . (AssocMap.safeFromSOPList . Map.toList <$>) $
     Map.unionsWith
       (Map.unionWith (+))
       ( [ Map.singleton cs (Map.singleton tn q)
-        | (cs, tokens) <- AssocMap.toList . getValue $ v
-        , (tn, q) <- AssocMap.toList tokens
+        | (cs, tokens) <- AssocMap.toSOPList . getValue $ v
+        , (tn, q) <- AssocMap.toSOPList tokens
         ]
       )
 
 -- | Creates an interval with Extended bounds
-interval' :: forall a. Extended a -> Extended a -> Interval a
+interval' :: (ToData a, UnsafeFromData a) => Extended a -> Extended a -> Interval a
 interval' from' to' = Interval (LowerBound from' False) (UpperBound to' False)
 
 hashTxInputs :: [TxInInfo] -> ByteString

plutus-benchmark/coop/src/PlutusBenchmark/Coop/Scripts.hs

@@ -14,21 +14,16 @@ import PlutusTx.Plugin ()
 import PlutusTx.Prelude
 import Prelude ()
 
-import PlutusLedgerApi.V1.Interval (contains)
-import PlutusLedgerApi.V1.Value (AssetClass (AssetClass), isZero, unAssetClass, valueOf,
-                                 withCurrencySymbol)
-import PlutusLedgerApi.V1.Value qualified as Value
-import PlutusLedgerApi.V2 (Datum, Extended (PosInf), Interval (Interval, ivTo),
-                           LedgerBytes (getLedgerBytes), LowerBound (LowerBound),
-                           ScriptContext (ScriptContext), ScriptPurpose (Minting),
-                           TokenName (TokenName), TxId (getTxId), TxInInfo (TxInInfo),
-                           TxInfo (TxInfo, txInfoData, txInfoInputs, txInfoMint, txInfoOutputs, txInfoReferenceInputs, txInfoSignatories, txInfoValidRange),
-                           TxOut (TxOut, txOutAddress, txOutDatum, txOutValue),
-                           TxOutRef (TxOutRef, txOutRefId, txOutRefIdx), UpperBound (UpperBound),
-                           Value (Value, getValue))
-import PlutusTx.AssocMap qualified as AssocMap
+import PlutusLedgerApi.Data.V2
+import PlutusLedgerApi.V1.Data.Interval (contains)
+import PlutusLedgerApi.V1.Data.Value (isZero, unAssetClass, valueOf, withCurrencySymbol)
+import PlutusLedgerApi.V1.Data.Value qualified as Value
+
+import PlutusTx.Builtins qualified as Builtins
 import PlutusTx.Builtins.Internal qualified as BI
-import PlutusTx.List (elem, find, foldl, null)
+import PlutusTx.Data.AssocMap qualified as AssocMap
+import PlutusTx.Data.List (elem, foldl)
+import PlutusTx.List qualified as BIList
 
 import PlutusBenchmark.Coop.Types
 import PlutusBenchmark.Coop.Utils
@@ -114,7 +109,7 @@ fsMp'
             let
               predicate (CertDatum {..}) =
                 0 < valueOf txInVal ap'authTokenCs (TokenName $ getLedgerBytes cert'id)
-            in case find predicate validCerts of
+            in case BIList.find predicate validCerts of
               Nothing -> traceError "$AUTH must be validated with a $CERT"
               Just (CertDatum {..}) ->
                 let
@@ -152,13 +147,13 @@ fsMp'
              matchWithAuth (myFsTn', unusedAuthInputs'') authInput =
                (myFsTn', (authInput : unusedAuthInputs''))
 
-             (mayFsTn, unusedAuthInputs') = foldl matchWithAuth (Nothing, mempty) unusedAuthInputs
+             (mayFsTn, unusedAuthInputs') = BIList.foldl matchWithAuth (Nothing, mempty) unusedAuthInputs
            in case mayFsTn of
                  Nothing -> traceError "$FS must have a token name formed from a matching $AUTH input"
                  Just fsTn -> (fsToMint' <> Value.singleton ownCs fsTn 1, unusedAuthInputs')
 
     (fsToMint, restAuths) = foldl go (mempty, validAuthInputs) txInfoOutputs
-    !_checkAuthUse = errorIfFalse "Auth inputs must ALL be used" $ null restAuths
+    !_checkAuthUse = errorIfFalse "Auth inputs must ALL be used" $ BIList.null restAuths
     !_checkBurn =
       errorIfFalse "" $
         currencyValue ownCs txInfoMint == fsToMint
@@ -211,13 +206,11 @@ authMp'
            "Must mint at least one $AUTH token:\n"
            <> "Must have a specified CurrencySymbol in the Value"
        Just tokenNameMap ->
-         case AssocMap.toList tokenNameMap of
-           [(k, v)] | k == (TokenName authId) ->
-                      errorIfFalse "Must mint at least one $AUTH token" (0 < v)
-           _ ->
-             traceError $
-               "Must mint at least one $AUTH token: \n"
-               <> "Must have exactly one TokenName under specified CurrencySymbol"
+         let
+           (kv, rest) = Builtins.unsafeUncons (AssocMap.toBuiltinList tokenNameMap)
+           k = BI.unsafeDataAsB $ BI.fst kv
+           v = BI.unsafeDataAsI $ BI.snd kv
+         in errorIfFalse "Must mint at least one $AUTH token" (0 < v && BI.null rest && k == authId)
 authMp' _ _ _ = traceError "incorrect purpose"
 {-# INLINE authMp' #-}
 
@@ -232,7 +225,7 @@ certMp'
   let
     tnBytes =
       let
-        AssetClass (aaCs, aaTn) = cmp'authAuthorityAc
+        (aaCs, aaTn) = unAssetClass cmp'authAuthorityAc
         go acc@(aaVal, tnBytes'') (TxInInfo (TxOutRef {txOutRefId = txId, txOutRefIdx = txIdx}) (TxOut {txOutValue = txInVal})) =
           if hasCurrency aaCs txInVal
           then (aaVal + valueOf txInVal aaCs aaTn, tnBytes'' <> consByteString txIdx (getTxId txId))
@@ -271,6 +264,8 @@ certMp'
    (Minting ownCs)
   ) =
   let
+    inputSum =
+      foldl (\acc (TxInInfo _ (TxOut {txOutValue})) -> acc + txOutValue) mempty txInfoInputs
     go shouldBurn' (TxInInfo _ (TxOut {txOutValue = txInVal, txOutDatum = txOutDatum})) =
       if hasCurrency ownCs txInVal
       then
@@ -281,9 +276,7 @@ certMp'
             contains
             (Interval (LowerBound certValidUntil False) (UpperBound PosInf True))
             txInfoValidRange
-          AssetClass (redeemerCs, redeemerName) = cert'redeemerAc
-          inputSum =
-            foldl (\acc (TxInInfo _ (TxOut {txOutValue})) -> acc + txOutValue) mempty txInfoInputs
+          (redeemerCs, redeemerName) = unAssetClass cert'redeemerAc
           !_spendAtLeast =
             errorIfFalse
               "Not have at least one token specified by redeemer spent"

plutus-benchmark/coop/src/PlutusBenchmark/Coop/TestContext.hs

@@ -13,9 +13,9 @@ module PlutusBenchmark.Coop.TestContext (
   correctAuthMpBurningContext,
   ) where
 
-import PlutusLedgerApi.V1.Address (scriptHashAddress)
-import PlutusLedgerApi.V1.Value (AssetClass, CurrencySymbol (..), TokenName (..), assetClass)
-import PlutusLedgerApi.V2 (Address, ScriptContext, ScriptHash (..))
+import PlutusLedgerApi.Data.V2 (Address, ScriptContext, ScriptHash (..))
+import PlutusLedgerApi.V1.Data.Address (scriptHashAddress)
+import PlutusLedgerApi.V1.Data.Value (AssetClass, CurrencySymbol (..), TokenName (..), assetClass)
 
 import Test.QuickCheck.Gen (Gen (unGen))
 import Test.QuickCheck.Random (mkQCGen)

plutus-benchmark/coop/src/PlutusBenchmark/Coop/Types.hs

@@ -8,9 +8,10 @@ module PlutusBenchmark.Coop.Types where
 import Prelude qualified as HS
 
 import Control.Lens (makeFields)
-import PlutusLedgerApi.V1.Value (AssetClass)
-import PlutusLedgerApi.V3 (Address, CurrencySymbol, Extended, LedgerBytes, POSIXTime,
-                           POSIXTimeRange, PubKeyHash)
+
+import PlutusLedgerApi.Data.V2
+import PlutusLedgerApi.V1.Data.Value (AssetClass)
+
 import PlutusTx.IsData qualified as PlutusTx
 import PlutusTx.Lift qualified as PlutusTx
 import PlutusTx.Prelude

plutus-benchmark/coop/src/PlutusBenchmark/Coop/Utils.hs

@@ -7,27 +7,25 @@ module PlutusBenchmark.Coop.Utils where
 import PlutusTx.Prelude
 import Prelude ()
 
-import PlutusLedgerApi.V1.Value (Value (Value), flattenValue, valueOf, withCurrencySymbol)
-import PlutusLedgerApi.V2 (CurrencySymbol, Datum (Datum), DatumHash,
-                           OutputDatum (NoOutputDatum, OutputDatum, OutputDatumHash),
-                           ScriptContext (ScriptContext), ScriptPurpose (Spending), TxId (TxId),
-                           TxInInfo (TxInInfo, txInInfoOutRef),
-                           TxInfo (TxInfo, txInfoInputs, txInfoMint), TxOut (TxOut, txOutValue),
-                           TxOutRef (TxOutRef))
-import PlutusTx.AssocMap (Map, lookup)
-import PlutusTx.AssocMap qualified as AssocMap
+import PlutusLedgerApi.V1 (Datum (Datum), DatumHash)
+import PlutusLedgerApi.V1.Data.Value
+import PlutusLedgerApi.V2.Data.Contexts
+import PlutusLedgerApi.V2.Data.Tx
+import PlutusTx.BuiltinList qualified as BIList
 import PlutusTx.Builtins.Internal qualified as BI
-import PlutusTx.List (find)
+import PlutusTx.Data.AssocMap (Map, lookup)
+import PlutusTx.Data.AssocMap qualified as AssocMap
+import PlutusTx.Data.List (List, find)
 
-findOwnInput :: [TxInInfo] -> TxOutRef -> TxInInfo
-findOwnInput inputs oref =
+findOwnInput' :: List TxInInfo -> TxOutRef -> TxInInfo
+findOwnInput' inputs oref =
   case find (\i -> txInInfoOutRef i == oref) inputs of
     Nothing -> traceError "findOwnInput: not found"
     Just x  -> x
 
 mustBurnOwnSingletonValue :: ScriptContext -> BuiltinUnit
 mustBurnOwnSingletonValue (ScriptContext (TxInfo {..}) (Spending oref)) =
-  let (TxInInfo _ (TxOut {txOutValue = ownInputValue})) = findOwnInput txInfoInputs oref
+  let (TxInInfo _ (TxOut {txOutValue = ownInputValue})) = findOwnInput' txInfoInputs oref
   -- flattenValue actually reverses order. See plutus#7173.
   in case flattenValue ownInputValue of
     [(cs, tk, q), _ada] ->
@@ -47,25 +45,32 @@ resolveDatum datums outputDatum =
         Nothing        -> traceError "expected datum but given datum hash have no associated datum"
         Just (Datum d) -> unsafeFromBuiltinData @a d
     OutputDatum (Datum d) -> unsafeFromBuiltinData @a d
+{-# INLINE resolveDatum #-}
 
 currencyValue :: CurrencySymbol -> Value -> Value
 currencyValue cs val = withCurrencySymbol cs val mempty (\v -> Value $ AssocMap.singleton cs v)
+{-# INLINE currencyValue #-}
 
 unsafeMergeMap :: AssocMap.Map k v -> AssocMap.Map k v -> AssocMap.Map k v
-unsafeMergeMap x y = AssocMap.unsafeFromList (AssocMap.toList x <> AssocMap.toList y)
+unsafeMergeMap x y = AssocMap.unsafeFromBuiltinList (BIList.append (AssocMap.toBuiltinList x) (AssocMap.toBuiltinList y))
+{-# INLINE unsafeMergeMap #-}
 
 hashInput :: TxInInfo -> BuiltinByteString
 hashInput (TxInInfo (TxOutRef (TxId hash) idx) _)
   | idx < 256 = blake2b_256 (consByteString idx hash)
   | otherwise = traceError "hashInput: Transaction output index must fit in an octet"
+{-# INLINE hashInput #-}
 
 errorIfFalse :: BuiltinString -> Bool -> BuiltinUnit
 errorIfFalse msg False = traceError msg
 errorIfFalse _ True    = BI.unitval
+{-# INLINE errorIfFalse #-}
 
 errorIfTrue :: BuiltinString -> Bool -> BuiltinUnit
 errorIfTrue msg True = traceError msg
 errorIfTrue _ False  = BI.unitval
+{-# INLINE errorIfTrue #-}
 
 hasCurrency :: CurrencySymbol -> Value -> Bool
 hasCurrency cs (Value val) = AssocMap.member cs val
+{-# INLINE hasCurrency #-}

plutus-benchmark/coop/test/9.6/authMpBurning.golden.eval

@@ -1,6 +1,6 @@
-CPU:               160_613_384
-Memory:                799_466
-AST Size:                1_473
-Flat Size:               5_393
+CPU:                19_042_635
+Memory:                 53_369
+AST Size:                  831
+Flat Size:               4_680
 
 (con unit ())

plutus-benchmark/coop/test/9.6/authMpMinting.golden.eval

@@ -1,6 +1,6 @@
-CPU:               369_713_157
-Memory:              1_849_456
-AST Size:                1_473
-Flat Size:               6_790
+CPU:               269_125_801
+Memory:                799_729
+AST Size:                  831
+Flat Size:               6_081
 
 (con unit ())

plutus-benchmark/coop/test/9.6/certMpBurning.golden.eval

@@ -1,6 +1,6 @@
-CPU:             1_842_342_144
-Memory:             10_767_218
-AST Size:                3_160
-Flat Size:               8_041
+CPU:             1_597_882_373
+Memory:              5_951_548
+AST Size:                3_630
+Flat Size:               8_564
 
 (con unit ())