Merge remote-tracking branch 'upstream/master'

Emurgo · Nov 30, 2023 · bf7e23d · bf7e23d
2 parents 7f8ce61 + bf9b2aa
commit bf7e23d
Show file tree

Hide file tree

Showing 14 changed files with 990 additions and 30 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.0.6
+version:                1.0.1.0
 synopsis:               Plutus scripts used for benchmarking
 description:            Plutus scripts used for benchmarking.
 category:               Cardano,
@@ -66,6 +66,7 @@ library
     Cardano.Benchmarking.PlutusScripts.CustomCall
     Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop
     Cardano.Benchmarking.PlutusScripts.Loop
+    Cardano.Benchmarking.PlutusScripts.LoopV3
     Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop
 
   --------------------------

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts.hs
@@ -17,15 +17,16 @@ module Cardano.Benchmarking.PlutusScripts
 import           Prelude
 
 import           Data.ByteString.Lazy as LBS (ByteString)
-import           Data.Text(split, pack)
-import           Data.List(find)
-import           System.FilePath(takeBaseName)
+import           Data.List (find)
+import           Data.Text (pack, split)
+import           System.FilePath (takeBaseName)
 
 import           Cardano.Api
 
 import qualified Cardano.Benchmarking.PlutusScripts.CustomCall as CustomCall
 import qualified Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop as ECDSA
 import qualified Cardano.Benchmarking.PlutusScripts.Loop as Loop
+import qualified Cardano.Benchmarking.PlutusScripts.LoopV3 as LoopV3
 import qualified Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop as Schnorr
 import           Cardano.Benchmarking.ScriptAPI
 
@@ -35,6 +36,7 @@ getAllScripts =
   [ CustomCall.script
   , ECDSA.script
   , Loop.script
+  , LoopV3.script
   , Schnorr.script
   ]
 
@@ -59,6 +61,7 @@ encodePlutusScript
   = \case
     ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1) s -> textEnvelopeToJSON Nothing s
     ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2) s -> textEnvelopeToJSON Nothing s
+    ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV3) s -> textEnvelopeToJSON Nothing s
     _                                                       -> "{}"
 
 

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/LoopV3.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/LoopV3.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Cardano.Benchmarking.PlutusScripts.LoopV3 (script) where
+
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import           Prelude hiding (pred, ($), (&&), (<), (==))
+
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV3, PlutusScriptVersion (..),
+                   Script (..), toScriptInAnyLang)
+import           Cardano.Benchmarking.ScriptAPI
+import qualified Data.ByteString.Short as SBS
+
+import qualified PlutusLedgerApi.V3 as PlutusV3
+import           PlutusTx
+import           PlutusTx.Builtins (unsafeDataAsI)
+import           PlutusTx.Prelude hiding (Semigroup (..), unless, (.), (<$>))
+
+
+scriptName :: String
+scriptName
+  = prepareScriptName $(LitE . StringL . loc_module <$> qLocation)
+
+script :: PlutusBenchScript
+script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV3 scriptSerialized))
+
+
+{-# INLINABLE mkValidator #-}
+mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()
+mkValidator _datum redeemer _txContext
+  = if n < 1000000
+       then traceError "redeemer is < 1000000"
+       else loop n
+  where
+    n = unsafeDataAsI redeemer
+    loop i = if i == 1000000 then () else loop $ pred i
+
+loopScriptShortBs :: SBS.ShortByteString
+loopScriptShortBs = PlutusV3.serialiseCompiledCode $$(PlutusTx.compile [|| mkValidator ||])
+
+scriptSerialized :: PlutusScript PlutusScriptV3
+scriptSerialized = PlutusScriptSerialised loopScriptShortBs