Merge pull request #5889 from IntersectMBO/bench-master

bench: implement CIP-69 and CIP-117 for benchmarking
IntersectMBO · Jun 27, 2024 · 8874c19 · 8874c19
2 parents 06943b6 + 3a164a3
commit 8874c19
Show file tree

Hide file tree

Showing 10 changed files with 701 additions and 669 deletions.
diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal
@@ -1,6 +1,6 @@
 cabal-version:          3.0
 name:                   plutus-scripts-bench
-version:                1.0.3.0
+version:                1.0.4.0
 synopsis:               Plutus scripts used for benchmarking
 description:            Plutus scripts used for benchmarking.
 category:               Cardano,
@@ -91,7 +91,6 @@ library
   build-depends:
     , filepath
     , bytestring
-    -- , serialise
     , template-haskell
     , text
 

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/HashOntoG2AndAdd.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/HashOntoG2AndAdd.hs
@@ -20,12 +20,13 @@ import qualified PlutusLedgerApi.V3 as PlutusV3
 import           Prelude as Haskell (String, (.), (<$>))
 
 import qualified Data.ByteString.Short as SBS
-import           GHC.ByteOrder (ByteOrder(LittleEndian))
+import           GHC.ByteOrder (ByteOrder (LittleEndian))
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
 import qualified PlutusTx
-import qualified PlutusTx.Builtins.Internal as BI (unitval)
+import qualified PlutusTx.Builtins.Internal as BI (BuiltinList, head, snd, tail, unitval,
+                   unsafeDataAsConstr)
 import           PlutusTx.Prelude as Tx hiding (Semigroup (..), (.), (<$>))
 
 
@@ -37,15 +38,26 @@ script :: PlutusBenchScript
 script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV3 scriptSerialized))
 
 {-# INLINABLE mkValidator #-}
-mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
-mkValidator _datum red _txContext =
-  case PlutusV3.fromBuiltinData red of
-    Nothing -> Tx.traceError "invalid redeemer"
-    Just (n, l) ->
-      if n < (1000000 :: Integer) -- large number ensures same bitsize for all counter values
-      then traceError "redeemer is < 1000000"
-      else loop n l
+mkValidator :: BuiltinData -> BuiltinUnit
+mkValidator arg =
+  if red_n < 1000000 -- large number ensures same bitsize for all counter values
+    then traceError "redeemer is < 1000000"
+    else loop red_n red_l
   where
+    -- lazily decode script context up to redeemer, which is less expensive and results in much smaller tx size
+    constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
+    constrArgs = BI.snd . BI.unsafeDataAsConstr
+
+    redeemerFollowedByScriptInfo :: BI.BuiltinList BuiltinData
+    redeemerFollowedByScriptInfo = BI.tail (constrArgs arg)
+
+    redeemer :: BuiltinData
+    redeemer = BI.head redeemerFollowedByScriptInfo
+
+    red_n :: Integer
+    red_l :: [BuiltinByteString]
+    (red_n, red_l) = PlutusV3.unsafeFromBuiltinData redeemer
+
     hashAndAddG2 :: [BuiltinByteString] -> Integer -> BuiltinBLS12_381_G2_Element
     hashAndAddG2 l i =
       go l (Tx.bls12_381_G2_uncompress Tx.bls12_381_G2_compressed_zero)

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/LoopV3.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/LoopV3.hs
@@ -18,8 +18,9 @@ import qualified Data.ByteString.Short as SBS
 import qualified PlutusLedgerApi.V3 as PlutusV3
 import           PlutusTx
 import           PlutusTx.Builtins (unsafeDataAsI)
-import qualified PlutusTx.Builtins.Internal as BI (unitval)
-import           PlutusTx.Prelude hiding (Semigroup (..), unless, (.), (<$>))
+import qualified PlutusTx.Builtins.Internal as BI (BuiltinList, head, snd, tail, unitval,
+                   unsafeDataAsConstr)
+import           PlutusTx.Prelude as Plutus hiding (Semigroup (..), unless, (.), (<$>))
 
 
 scriptName :: String
@@ -31,14 +32,25 @@ script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusS
 
 
 {-# INLINABLE mkValidator #-}
-mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> BuiltinUnit
-mkValidator _datum redeemer _txContext
-  = if n < 1000000
-       then traceError "redeemer is < 1000000"
-       else loop n
+mkValidator :: BuiltinData -> BuiltinUnit
+mkValidator arg =
+  if red_n < 1000000
+    then traceError "redeemer is < 1000000" -- large number ensures same bitsize for all counter values
+    else loop red_n
   where
-    n = unsafeDataAsI redeemer
-    loop i = if i == 1000000 then BI.unitval else loop $ pred i
+    -- lazily decode script context up to redeemer, which is less expensive and results in much smaller tx size
+    constrArgs :: BuiltinData -> BI.BuiltinList BuiltinData
+    constrArgs = BI.snd . BI.unsafeDataAsConstr
+
+    redeemerFollowedByScriptInfo :: BI.BuiltinList BuiltinData
+    redeemerFollowedByScriptInfo = BI.tail (constrArgs arg)
+
+    redeemer :: BuiltinData
+    redeemer = BI.head redeemerFollowedByScriptInfo
+
+    red_n = unsafeDataAsI redeemer
+
+    loop i = if i == 1000000 then BI.unitval else loop (pred i)
 
 loopScriptShortBs :: SBS.ShortByteString
 loopScriptShortBs = PlutusV3.serialiseCompiledCode $$(PlutusTx.compile [|| mkValidator ||])