Spec that verifies various script sizes (#6247)

plutus-ledger-api/plutus-ledger-api.cabal

@@ -192,11 +192,14 @@ test-suite plutus-ledger-api-plugin-test
  Spec.ReturnUnit.V1
  Spec.ReturnUnit.V2
  Spec.ReturnUnit.V3
+ Spec.ScriptSize
  Spec.Value
 
  build-depends:
  , base >=4.9 && <5
+ , bytestring
  , containers
+ , lens
  , mtl
  , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.30
  , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.30

plutus-ledger-api/test-plugin/Spec.hs

@@ -6,6 +6,7 @@ import Spec.Data.Value qualified
 import Spec.ReturnUnit.V1 qualified
 import Spec.ReturnUnit.V2 qualified
 import Spec.ReturnUnit.V3 qualified
+import Spec.ScriptSize qualified
 import Spec.Value qualified
 
 import Test.Tasty
@@ -14,12 +15,15 @@ main :: IO ()
 main = defaultMain tests
 
 tests :: TestTree
-tests = testGroup "plutus-ledger-api-plugin-test"
+tests =
+ testGroup
+ "plutus-ledger-api-plugin-test"
  [ Spec.Budget.tests
- , Spec.Value.test_EqValue
+ , Spec.Data.Budget.tests
+ , Spec.Data.Value.test_EqValue
  , Spec.ReturnUnit.V1.tests
  , Spec.ReturnUnit.V2.tests
  , Spec.ReturnUnit.V3.tests
- , Spec.Data.Budget.tests
- , Spec.Data.Value.test_EqValue
+ , Spec.ScriptSize.tests
+ , Spec.Value.test_EqValue
  ]

plutus-ledger-api/test-plugin/Spec/ScriptSize.hs

@@ -0,0 +1,202 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
+
+module Spec.ScriptSize where
+
+import PlutusTx.Prelude
+import Prelude qualified as Haskell
+
+import Control.Lens ((&), (^.))
+import Data.ByteString.Short qualified as SBS
+import PlutusCore.Default (DefaultFun, DefaultUni)
+import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParametersForTesting)
+import PlutusCore.StdLib.Data.Unit (unitval)
+import PlutusLedgerApi.V2 qualified as V2
+import PlutusLedgerApi.V3 qualified as V3
+import PlutusTx (CompiledCode, liftCodeDef, unsafeApplyCode)
+import PlutusTx.AssocMap qualified as Map
+import PlutusTx.Builtins.Internal qualified as BI
+import PlutusTx.Code (getPlc)
+import PlutusTx.TH (compile)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, assertFailure, testCase)
+import UntypedPlutusCore.Core.Type (progTerm)
+import UntypedPlutusCore.Evaluation.Machine.Cek (counting, noEmitter)
+import UntypedPlutusCore.Evaluation.Machine.Cek.Internal (NTerm, runCekDeBruijn)
+
+tests :: TestTree
+tests =
+ testGroup
+ "Script Size"
+ [ testCase "V2 Script Size" do
+ let sizeV2 = SBS.length (V2.serialiseCompiledCode codeV2)
+ assertBool "Size V2 script" $ sizeV2 Haskell.< 100
+ , testCase "V3 Script Size" do
+ let sizeV3 = SBS.length (V3.serialiseCompiledCode codeV3)
+ assertBool "Size V3 script" $ sizeV3 Haskell.> 2000
+ , testCase "V3 Script Size (lazy decoding)" do
+ let sizeV3s = SBS.length (V3.serialiseCompiledCode codeV3lazy)
+ assertBool "Size V3 script with a lazy decoding" $ sizeV3s Haskell.< 100
+ , testCase "V3 script evaluates correctly" do
+ unsafeApplyCode codeV3 (liftCodeDef (V3.toBuiltinData dummyScriptContext))
+ & assertResult unitval
+ , testCase "V3 (lazy) script evaluates correctly" do
+ unsafeApplyCode codeV3lazy (liftCodeDef (V3.toBuiltinData dummyScriptContext))
+ & assertResult unitval
+ ]
+
+codeV2 :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())
+codeV2 = $$(compile [||validatorV2||])
+ where
+ validatorV2 :: BuiltinData -> BuiltinData -> BuiltinData -> ()
+ validatorV2 datumBuiltinData redeemerBuiltinData _scriptContext =
+ if expected == redeemer && expected == datum
+ then ()
+ else error ()
+ where
+ redeemer :: Integer
+ redeemer = V2.unsafeFromBuiltinData redeemerBuiltinData
+
+ datum :: Integer
+ datum = V2.unsafeFromBuiltinData datumBuiltinData
+
+codeV3 :: CompiledCode (BuiltinData -> BuiltinUnit)
+codeV3 = $$(compile [||validatorV3||])
+ where
+ validatorV3 :: BuiltinData -> BuiltinUnit
+ validatorV3 scriptContext =
+ if expected == redeemer && Haskell.Just expected == datum
+ then BI.unitval
+ else error ()
+ where
+ redeemer :: Integer
+ redeemer = V3.unsafeFromBuiltinData redeemerBuiltinData
+
+ datum :: Haskell.Maybe Integer
+ datum = V3.unsafeFromBuiltinData . V3.getDatum <$> optionalDatum
+
+ (redeemerBuiltinData, optionalDatum) =
+ case V3.unsafeFromBuiltinData scriptContext of
+ V3.ScriptContext
+ _txInfo
+ (V3.Redeemer redeemerBuiltinData')
+ (V3.SpendingScript _txOutRef optionalDatum') ->
+ (redeemerBuiltinData', optionalDatum')
+ _ -> error ()
+
+codeV3lazy :: CompiledCode (BuiltinData -> BuiltinUnit)
+codeV3lazy = $$(compile [||validatorV3smart||])
+ where
+ validatorV3smart :: BuiltinData -> BuiltinUnit
+ validatorV3smart scriptContext =
+ if expected == redeemer && expected == datum
+ then BI.unitval
+ else error ()
+ where
+ redeemerFollowedByScriptInfo :: BI.BuiltinList BuiltinData
+ redeemerFollowedByScriptInfo = BI.tail (constrArgs scriptContext)
+
+ redeemerBuiltinData :: BuiltinData
+ redeemerBuiltinData = BI.head redeemerFollowedByScriptInfo
+
+ scriptInfoData :: BuiltinData
+ scriptInfoData = BI.head (BI.tail redeemerFollowedByScriptInfo)
+
+ datumData :: BuiltinData
+ datumData = BI.head (constrArgs (BI.head (BI.tail (constrArgs scriptInfoData))))
+
+ redeemer :: Integer
+ redeemer = V3.unsafeFromBuiltinData redeemerBuiltinData
+
+ datum :: Integer
+ datum = V3.unsafeFromBuiltinData (V3.getDatum (V3.unsafeFromBuiltinData datumData))
+
+constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
+constrArgs = BI.snd . BI.unsafeDataAsConstr
+
+expected :: Integer
+expected = 42
+
+{-
+ Constr
+ 0
+ [ Constr
+ 0
+ [ List []
+ , List []
+ , List []
+ , I 1000000
+ , Map []
+ , List []
+ , Map []
+ , Constr 0
+ [ Constr 0 [Constr 0 []
+ , Constr 1 []]
+ , Constr 0 [Constr 2 []
+ , Constr 1 []]
+ ]
+ , List []
+ , Map []
+ , Map []
+ , B ""
+ , Map []
+ , List []
+ , Constr 1 []
+ , Constr 1 []
+ ]
+ , I 42
+ , Constr
+ 1
+ [ Constr 0 [B "", I 100]
+ , Constr 0 [I 42]
+ ]
+ ]
+-}
+dummyScriptContext :: V3.ScriptContext
+dummyScriptContext =
+ V3.ScriptContext
+ { V3.scriptContextTxInfo =
+ V3.TxInfo
+ { V3.txInfoInputs = []
+ , V3.txInfoReferenceInputs = []
+ , V3.txInfoOutputs = []
+ , V3.txInfoFee = 1000000 :: V3.Lovelace
+ , V3.txInfoMint = mempty
+ , V3.txInfoTxCerts = []
+ , V3.txInfoWdrl = Map.empty
+ , V3.txInfoValidRange =
+ V3.Interval
+ { V3.ivFrom = V3.LowerBound V3.NegInf True
+ , V3.ivTo = V3.UpperBound V3.PosInf True
+ }
+ , V3.txInfoSignatories = []
+ , V3.txInfoRedeemers = Map.empty
+ , V3.txInfoData = Map.empty
+ , V3.txInfoId = V3.TxId mempty
+ , V3.txInfoVotes = Map.empty
+ , V3.txInfoProposalProcedures = []
+ , V3.txInfoCurrentTreasuryAmount = Haskell.Nothing
+ , V3.txInfoTreasuryDonation = Haskell.Nothing
+ }
+ , V3.scriptContextRedeemer =
+ V3.Redeemer (V3.toBuiltinData expected)
+ , V3.scriptContextScriptInfo =
+ V3.SpendingScript
+ V3.TxOutRef
+ { V3.txOutRefId = V3.TxId mempty
+ , V3.txOutRefIdx = 100 :: Integer
+ }
+ (Haskell.Just (V3.Datum (V3.toBuiltinData expected)))
+ }
+
+assertResult :: NTerm DefaultUni DefaultFun () -> CompiledCode a -> Assertion
+assertResult expectedResult code = do
+ let plc = getPlc code ^. progTerm
+ case runCekDeBruijn defaultCekParametersForTesting counting noEmitter plc of
+ (Left ex, _counting, _logs) ->
+ assertFailure $ Haskell.show ex
+ (Right actualResult, _counting, _logs) ->
+ assertEqual "Evaluation has succeeded" expectedResult actualResult