plutus-scripts-bench: Use TH-generated scripts.

This helps keep flake dependencies down & avoids having to go through a different team for changes to the scripts.
IntersectMBO · Apr 7, 2023 · 74098c1 · 74098c1
1 parent be1dd96
commit 74098c1
Show file tree

Hide file tree

Showing 14 changed files with 89 additions and 57 deletions.
diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal
@@ -56,6 +56,7 @@ library
   exposed-modules:
     Cardano.Benchmarking.PlutusScripts
     Cardano.Benchmarking.PlutusScripts.CustomCallTypes
+    Cardano.Benchmarking.ScriptAPI
 
   other-modules:
     Cardano.Benchmarking.PlutusScripts.CustomCall
@@ -76,6 +77,8 @@ library
   -- Non-IOG dependencies
   ------------------------
   build-depends:
+    , text
     , bytestring
     , serialise
     , template-haskell
+    , filepath
diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts.hs
@@ -10,39 +10,40 @@ module Cardano.Benchmarking.PlutusScripts
     , findPlutusScript
     , getAllScripts
     , listPlutusScripts
+    , asAnyLang
+    , normalizeModuleName
     ) where
 
 import           Prelude
 
 import           Data.ByteString.Lazy as LBS (ByteString)
+import           Data.Text(split, pack)
+import           Data.Maybe(listToMaybe)
+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.SchnorrSecp256k1Loop as Schnorr
+import           Cardano.Benchmarking.ScriptAPI
 
 
-getAllScripts ::
-     [(String, ScriptInAnyLang)]
+getAllScripts :: [BenchScript]
 getAllScripts =
-  [ (normalizeModuleName CustomCall.scriptName, asAnyLang CustomCall.scriptSerialized)
-  , (normalizeModuleName ECDSA.scriptName     , asAnyLang ECDSA.scriptSerialized)
-  , (normalizeModuleName Loop.scriptName      , asAnyLang Loop.scriptSerialized)
-  , (normalizeModuleName Schnorr.scriptName   , asAnyLang Schnorr.scriptSerialized)
-  ]
+  [ CustomCall.script, ECDSA.script, Loop.script, Schnorr.script ]
 
 listPlutusScripts ::
      [String]
 listPlutusScripts
-  = fst <$> getAllScripts
+  = psName <$> getAllScripts
 
 findPlutusScript ::
      String
   -> Maybe ScriptInAnyLang
-findPlutusScript
-  = (`lookup` getAllScripts)
+findPlutusScript s
+  = listToMaybe [psScript t | t <- getAllScripts, last (split (=='.') . pack $ psName t) == pack (takeBaseName s)]
 
 encodePlutusScript ::
      ScriptInAnyLang

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCall.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCall.hs
@@ -7,24 +7,24 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Cardano.Benchmarking.PlutusScripts.CustomCall
-  ( scriptName
-  , scriptSerialized
-  ) where
+module Cardano.Benchmarking.PlutusScripts.CustomCall (script) where
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
 import           Prelude as Haskell (String, (.), (<$>))
 
-import           Cardano.Api (PlutusScript, PlutusScriptV2)
-import           Cardano.Api.Shelley (PlutusScript (..))
+import           Cardano.Api (PlutusScriptV2, toScriptInAnyLang, Script(..))
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
 import qualified Data.ByteString.Short as SBS
 import qualified PlutusLedgerApi.V2 as PlutusV2
 import qualified PlutusTx
 import           PlutusTx.Prelude as Plutus hiding (Semigroup (..), (.), (<$>))
 
+import           Cardano.Benchmarking.ScriptAPI
 import           Cardano.Benchmarking.PlutusScripts.CustomCallTypes
 
+script :: BenchScript
+script = mkBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
 
 scriptName :: Haskell.String
 scriptName

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/EcdsaSecp256k1Loop.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/EcdsaSecp256k1Loop.hs
@@ -4,16 +4,14 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop
-  ( scriptName
-  , scriptSerialized
-  ) where
+module Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop (script) where
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
 
-import           Cardano.Api (PlutusScript, PlutusScriptV2)
-import           Cardano.Api.Shelley (PlutusScript (..))
+import           Cardano.Api (PlutusScript, PlutusScriptV2, Script(..), toScriptInAnyLang)
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
+import           Cardano.Benchmarking.ScriptAPI
 import qualified Data.ByteString.Short as SBS
 import qualified PlutusLedgerApi.V2 as PlutusV2
 import qualified PlutusTx
@@ -26,6 +24,9 @@ scriptName :: Haskell.String
 scriptName
   = $(LitE . StringL . loc_module <$> qLocation)
 
+script :: BenchScript
+script = mkBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
+
 
 {-# INLINEABLE mkValidator #-}
 mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/Loop.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/Loop.hs
@@ -4,17 +4,14 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Cardano.Benchmarking.PlutusScripts.Loop
-  ( scriptName
-  , scriptSerialized
-  ) where
+module Cardano.Benchmarking.PlutusScripts.Loop (script) where
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
 import           Prelude hiding (pred, ($), (&&), (<), (==))
 
-import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
-
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1, Script(..), toScriptInAnyLang, PlutusScriptVersion(..))
+import           Cardano.Benchmarking.ScriptAPI
 import qualified Data.ByteString.Short as SBS
 
 import qualified PlutusLedgerApi.V2 as PlutusV2
@@ -27,6 +24,9 @@ scriptName :: String
 scriptName
   = $(LitE . StringL . loc_module <$> qLocation)
 
+script :: BenchScript
+script = mkBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV1 scriptSerialized))
+
 
 {-# INLINABLE mkValidator #-}
 mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/SchnorrSecp256k1Loop.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/SchnorrSecp256k1Loop.hs
@@ -4,16 +4,14 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop
-  ( scriptName
-  , scriptSerialized
-  ) where
+module Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop (script) where
 
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
 
-import           Cardano.Api (PlutusScript, PlutusScriptV2)
-import           Cardano.Api.Shelley (PlutusScript (..))
+import           Cardano.Api (PlutusScript, PlutusScriptV2, Script(..), toScriptInAnyLang)
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
+import           Cardano.Benchmarking.ScriptAPI
 import qualified Data.ByteString.Short as SBS
 import qualified PlutusLedgerApi.V2 as PlutusV2
 import qualified PlutusTx
@@ -26,6 +24,9 @@ scriptName :: Haskell.String
 scriptName
   = $(LitE . StringL . loc_module <$> qLocation)
 
+script :: BenchScript
+script = mkBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
+
 
 {-# INLINEABLE mkValidator #-}
 mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()

diff --git a/bench/plutus-scripts-bench/src/Cardano/Benchmarking/ScriptAPI.hs b/bench/plutus-scripts-bench/src/Cardano/Benchmarking/ScriptAPI.hs
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Cardano.Benchmarking.ScriptAPI
+  (BenchScript, psName, psScript, mkBenchScript)
+  where
+
+import           Prelude as Haskell (String)
+import           Cardano.Api (ScriptInAnyLang)
+
+data BenchScript
+  = BenchScript
+    { psName   :: String
+    , psScript :: ScriptInAnyLang
+    }
+
+mkBenchScript :: String -> ScriptInAnyLang -> BenchScript
+mkBenchScript = BenchScript
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -23,7 +23,6 @@ import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Except.Extra
 import           "contra-tracer" Control.Tracer (nullTracer)
 import           Data.ByteString.Lazy.Char8 as BSL (writeFile)
-import           Data.List (isSuffixOf)
 import           Data.Ratio ((%))
 
 import           Streaming
@@ -55,7 +54,6 @@ import           Cardano.TxGenerator.Setup.SigningKey
 
 import           Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile,
                    makeLocalConnectInfo, protocolToCodecConfig)
-import           Cardano.Benchmarking.PlutusScripts (findPlutusScript)
 
 import           Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_,
                    btSubmission2_, btTxSubmit_)
@@ -409,12 +407,7 @@ makePlutusContext :: forall era. IsShelleyBasedEra era
   -> ActionM (Witness WitCtxTxIn era, ScriptInAnyLang, ScriptData, Lovelace)
 makePlutusContext ScriptSpec{..} = do
   protocolParameters <- getProtocolParameters
-  script <- if ".hs" `isSuffixOf` scriptSpecFile
-    then maybe
-          (liftTxGenError $ TxGenError $ "Plutus script not included: " ++ scriptSpecFile)
-          return
-          (findPlutusScript scriptSpecFile)
-    else liftIOSafe $ Plutus.readPlutusScript scriptSpecFile
+  script <- liftIOSafe $ Plutus.readPlutusScript scriptSpecFile
 
   executionUnitPrices <- case protocolParamPrices protocolParameters of
     Just x -> return x
@@ -458,15 +451,15 @@ makePlutusContext ScriptSpec{..} = do
       traceDebug $ "Plutus auto mode : Available budget per Tx: " ++ show perTxBudget
                    ++ " -- split between inputs per Tx: " ++ show txInputs
 
-      case plutusAutoScaleBlockfit protocolParameters scriptSpecFile script autoBudget strategy txInputs of
+      case plutusAutoScaleBlockfit protocolParameters (either ("builtin: "++) ("plutus file: "++) scriptSpecFile) script autoBudget strategy txInputs of
         Left err -> liftTxGenError err
         Right (summary, PlutusAutoBudget{..}, preRun) -> do
           setEnvSummary summary
           dumpBudgetSummaryIfExisting
           return (unsafeHashableScriptData autoBudgetDatum, autoBudgetRedeemer, preRun)
 
   let msg = mconcat [ "Plutus Benchmark :"
-                    , " Script: ", scriptSpecFile
+                    , " Script: ", show scriptSpecFile
                     , ", Datum: ", show scriptData
                     , ", Redeemer: ", show scriptRedeemer
                     , ", StatedBudget: ", show executionUnits

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
@@ -108,7 +108,7 @@ deriving instance Generic ScriptBudget
 
 data ScriptSpec = ScriptSpec
   {
-    scriptSpecFile :: !FilePath
+    scriptSpecFile :: !(Either String FilePath)
   , scriptSpecBudget :: !ScriptBudget
   , scriptSpecPlutusType :: !TxGenPlutusType
   }

diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs
@@ -27,14 +27,19 @@ import           Cardano.Ledger.Alonzo.TxInfo (exBudgetToExUnits)
 import qualified PlutusLedgerApi.V1 as PlutusV1
 import qualified PlutusLedgerApi.V2 as PlutusV2
 
+import           Cardano.Benchmarking.PlutusScripts(findPlutusScript)
 import           Cardano.TxGenerator.Types
 
 
 type ProtocolVersion = (Int, Int)
 
 
-readPlutusScript :: FilePath -> IO (Either TxGenError ScriptInAnyLang)
-readPlutusScript fp
+readPlutusScript :: Either String FilePath -> IO (Either TxGenError ScriptInAnyLang)
+readPlutusScript (Left s)
+  = return
+  $ maybe (Left . TxGenError $ "readPlutusScript: " ++ s ++ " not found.")
+            Right (findPlutusScript s)
+readPlutusScript (Right fp)
   = runExceptT $ do
     script <- firstExceptT ApiError $
       readFileScriptInAnyLang fp

diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs
@@ -90,7 +90,7 @@ data TxGenPlutusType
 data TxGenPlutusParams
   = PlutusOn                                    -- ^ Generate Plutus Txs for given script
       { plutusType        :: !TxGenPlutusType
-      , plutusScript      :: !FilePath          -- ^ Path to the Plutus script
+      , plutusScript      :: !(Either String FilePath) -- ^ Path to the Plutus script
       , plutusDatum       :: !(Maybe FilePath)  -- ^ Datum passed to the Plutus script (JSON file in ScriptData schema)
       , plutusRedeemer    :: !(Maybe FilePath)  -- ^ Redeemer passed to the Plutus script (JSON file in ScriptData schema)
       , plutusExecMemory  :: !(Maybe Natural)   -- ^ Max. memory for ExecutionUnits (overriding corresponding protocol parameter)

diff --git a/bench/tx-generator/test/ApiTest.hs b/bench/tx-generator/test/ApiTest.hs
@@ -10,6 +10,7 @@
 
 module Main (main) where
 
+import           Control.Arrow
 import           Control.Monad
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Except.Extra
@@ -155,7 +156,7 @@ checkPlutusLoop ::
 checkPlutusLoop (Just PlutusOn{..})
   = do
     script <- either (die . show) pure =<< readPlutusScript plutusScript
-    putStrLn $ "--> Read plutus script: " ++ plutusScript
+    putStrLn $ "--> Read plutus script: " ++ (id ||| id) plutusScript
     protocolParameters <- readProtocolParametersOrDie
 
     let count = 1_792        -- arbitrary counter for a loop script; should respect mainnet limits
@@ -202,9 +203,11 @@ checkPlutusLoop (Just PlutusOn{..})
     mul :: Natural -> Double -> Natural
     mul n d = floor $ d * fromIntegral n
 
-    getRedeemerFile =
-      let redeemerPath = (<.> ".redeemer.json") $ dropExtension $ takeFileName plutusScript
-      in getDataFileName $ "data" </> redeemerPath
+    getRedeemerFile
+      = case plutusScript of
+          Right file -> let redeemerPath = (<.> ".redeemer.json") $ dropExtension $ takeFileName file
+                        in getDataFileName $ "data" </> redeemerPath
+          Left _ -> getDataFileName "data/loop.redeemer.json"
 checkPlutusLoop _
   = putStrLn "--> No plutus script defined."
 

diff --git a/nix/nixos/tx-generator-service.nix b/nix/nixos/tx-generator-service.nix
@@ -5,7 +5,15 @@ let
       plutus = if (cfg.plutus.type or null) == null then null else
         {
           inherit (cfg.plutus) type;
-          script = "${pkgs.plutus-scripts}/generated-plutus-scripts/${cfg.plutus.script}";
+          ## Basically do something like:
+          ## script = "${pkgs.plutus-scripts}/generated-plutus-scripts/${cfg.plutus.script}";
+          ## except for having to weave the Either through things
+          script = if (cfg.plutus.script?Left)
+                     ## The internal ID doesn't need path qualification.
+                     then { Left = cfg.plutus.script.Left; }
+                     else { Right = pkgs.plutus-scripts
+                                              + "/generated-plutus-scripts/"
+                                              + cfg.plutus.script.Right; };
           redeemer = pkgs.writeText "plutus-redeemer.json" (__toJSON cfg.plutus.redeemer);
           datum    = if cfg.plutus.datum == null then null else
                      pkgs.writeText "plutus-datum.json"    (__toJSON cfg.plutus.datum);
@@ -66,7 +74,7 @@ in pkgs.commonLib.defServiceModule
         ##
         plutus = {
           type                = mayOpt str   "Plutus script type.";
-          script              = mayOpt str   "Name of the Plutus script from plutus-apps, prefixed with either of v1/v2.";
+          script              = mayOpt attrs "Name of the Plutus script from plutus-apps, prefixed with either of v1/v2.";
           limitExecutionMem   = mayOpt int   "Limit for saturation tuning: mem;  null means per-Tx limit from ProtocolParameters.";
           limitExecutionSteps = mayOpt int   "Limit for saturation tuning: steps;  null means per-Tx limit from ProtocolParameters.";
           datum               = mayOpt attrs "Plutus script datum.";

diff --git a/nix/workbench/profile/prof1-variants.jq b/nix/workbench/profile/prof1-variants.jq
@@ -276,7 +276,7 @@ def all_profile_variants:
    ({ generator:
       { plutus:
           { type:                       "LimitSaturationLoop"
-          , script:                     "v1/loop.plutus"
+          , script:                     { "Left": "Loop.hs" }
           , redeemer:
             { "int": 1000000 }
           }
@@ -288,7 +288,7 @@ def all_profile_variants:
    ({ generator:
       { plutus:
           { type:                      "LimitTxPerBlock_8"
-          , script:                    "v2/ecdsa-secp256k1-loop.plutus"
+          , script:                    { "Left": "EcdsaSecp256k1Loop.hs" }
           , redeemer:
             { constructor: 0
             , fields:
@@ -311,7 +311,7 @@ def all_profile_variants:
    ({ generator:
       { plutus:
           { type:                       "LimitTxPerBlock_8"
-          , script:                     "v2/schnorr-secp256k1-loop.plutus"
+          , script:                     { "Left": "SchnorrSecp256k1Loop.hs" }
           , redeemer:
             { constructor: 0
             , fields: