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

@@ -13,21 +13,15 @@ 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.Internal qualified as BI
-import PlutusTx.List (elem, find, foldl, null)
+import PlutusTx.Data.AssocMap qualified as AssocMap
+import PlutusTx.Data.List (cons, elem, foldl, null)
+import PlutusTx.List qualified as BIList
 
 import PlutusBenchmark.Coop.Types
 import PlutusBenchmark.Coop.Utils
@@ -113,14 +107,14 @@ 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
                   shouldbeBurned' =
                     shouldBeBurned
                     <> Value.singleton ap'authTokenCs (TokenName $ getLedgerBytes cert'id) (-1)
-                in (txIn : validAuthInputs'', shouldbeBurned')
+                in (cons txIn validAuthInputs'', shouldbeBurned')
           else acc
 
         (validAuthInputs', authTokensToBurn) = foldl go' (mempty, mempty) txInfoInputs
@@ -147,9 +141,9 @@ fsMp'
                in if (Value $ AssocMap.singleton ownCs ownCurrValue)
                      == Value.singleton ownCs fsTokenName 1
                   then (Just fsTokenName, unusedAuthInputs'')
-                  else (Nothing, authInput : unusedAuthInputs'')
+                  else (Nothing, cons authInput unusedAuthInputs'')
              matchWithAuth (myFsTn', unusedAuthInputs'') authInput =
-               (myFsTn', (authInput : unusedAuthInputs''))
+               (myFsTn', (cons authInput unusedAuthInputs''))
 
              (mayFsTn, unusedAuthInputs') = foldl matchWithAuth (Nothing, mempty) unusedAuthInputs
            in case mayFsTn of
@@ -210,7 +204,7 @@ authMp'
            "Must mint at least one $AUTH token:\n"
            <> "Must have a specified CurrencySymbol in the Value"
        Just tokenNameMap ->
-         case AssocMap.toList tokenNameMap of
+         case AssocMap.toSOPList tokenNameMap of
            [(k, v)] | k == (TokenName authId) ->
                       errorIfFalse "Must mint at least one $AUTH token" (0 < v)
            _ ->
@@ -231,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))
@@ -280,7 +274,7 @@ certMp'
             contains
             (Interval (LowerBound certValidUntil False) (UpperBound PosInf True))
             txInfoValidRange
-          AssetClass (redeemerCs, redeemerName) = cert'redeemerAc
+          (redeemerCs, redeemerName) = unAssetClass cert'redeemerAc
           inputSum =
             foldl (\acc (TxInInfo _ (TxOut {txOutValue})) -> acc + txOutValue) mempty txInfoInputs
           !_spendAtLeast =

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,24 @@ 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.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 +44,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 :: (ToData k, ToData v, UnsafeFromData k, UnsafeFromData v) => AssocMap.Map k v -> AssocMap.Map k v -> AssocMap.Map k v
+unsafeMergeMap x y = AssocMap.unsafeFromSOPList (AssocMap.toSOPList x <> AssocMap.toSOPList 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.eval.golden

@@ -1,6 +1,6 @@
-CPU:               275_949_863
-Memory:              1_044_479
-Term Size:               1_908
-Flat Size:               5_925
+CPU:                22_532_179
+Memory:                 58_279
+Term Size:                 908
+Flat Size:               4_859
 
 (con unit ())

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

@@ -1,6 +1,6 @@
-CPU:               595_852_740
-Memory:              2_373_857
-Term Size:               1_908
-Flat Size:               7_322
+CPU:               321_845_423
+Memory:                852_311
+Term Size:                 908
+Flat Size:               6_260
 
 (con unit ())

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

@@ -1,6 +1,6 @@
-CPU:             2_041_041_180
-Memory:             11_330_335
-Term Size:               3_698
-Flat Size:               8_707
+CPU:             7_153_841_977
+Memory:             23_035_266
+Term Size:               3_856
+Flat Size:               8_833
 
 (con unit ())

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

@@ -1,6 +1,6 @@
-CPU:               628_642_273
-Memory:              2_544_349
-Term Size:               3_698
-Flat Size:               9_230
+CPU:               450_505_963
+Memory:              1_349_628
+Term Size:               3_856
+Flat Size:               9_355
 
 (con unit ())