Skip to content

Commit 26af241

Browse files
mgmeiermgmeier
authored
Merge pull request #5048 from input-output-hk/nyc-plutus-bench-01
use TH-generated plutus scripts
2 parents 2dd271b + 2fe2c43 commit 26af241

File tree

14 files changed

+121
-59
lines changed

14 files changed

+121
-59
lines changed

Diff for: ‎bench/plutus-scripts-bench/plutus-scripts-bench.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ library
5656
exposed-modules:
5757
Cardano.Benchmarking.PlutusScripts
5858
Cardano.Benchmarking.PlutusScripts.CustomCallTypes
59+
Cardano.Benchmarking.ScriptAPI
5960

6061
other-modules:
6162
Cardano.Benchmarking.PlutusScripts.CustomCall
@@ -76,6 +77,8 @@ library
7677
-- Non-IOG dependencies
7778
------------------------
7879
build-depends:
80+
, filepath
7981
, bytestring
8082
, serialise
8183
, template-haskell
84+
, text

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts.hs

+17-9
Original file line numberDiff line numberDiff line change
@@ -10,39 +10,47 @@ module Cardano.Benchmarking.PlutusScripts
1010
, findPlutusScript
1111
, getAllScripts
1212
, listPlutusScripts
13+
, asAnyLang
14+
, normalizeModuleName
1315
) where
1416

1517
import Prelude
1618

1719
import Data.ByteString.Lazy as LBS (ByteString)
20+
import Data.Text(split, pack)
21+
import Data.List(find)
22+
import System.FilePath(takeBaseName)
1823

1924
import Cardano.Api
2025

2126
import qualified Cardano.Benchmarking.PlutusScripts.CustomCall as CustomCall
2227
import qualified Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop as ECDSA
2328
import qualified Cardano.Benchmarking.PlutusScripts.Loop as Loop
2429
import qualified Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop as Schnorr
30+
import Cardano.Benchmarking.ScriptAPI
2531

2632

27-
getAllScripts ::
28-
[(String, ScriptInAnyLang)]
33+
getAllScripts :: [PlutusBenchScript]
2934
getAllScripts =
30-
[ (normalizeModuleName CustomCall.scriptName, asAnyLang CustomCall.scriptSerialized)
31-
, (normalizeModuleName ECDSA.scriptName , asAnyLang ECDSA.scriptSerialized)
32-
, (normalizeModuleName Loop.scriptName , asAnyLang Loop.scriptSerialized)
33-
, (normalizeModuleName Schnorr.scriptName , asAnyLang Schnorr.scriptSerialized)
35+
[ CustomCall.script
36+
, ECDSA.script
37+
, Loop.script
38+
, Schnorr.script
3439
]
3540

3641
listPlutusScripts ::
3742
[String]
3843
listPlutusScripts
39-
= fst <$> getAllScripts
44+
= psName <$> getAllScripts
4045

4146
findPlutusScript ::
4247
String
4348
-> Maybe ScriptInAnyLang
44-
findPlutusScript
45-
= (`lookup` getAllScripts)
49+
findPlutusScript s
50+
= psScript
51+
<$> find (\x -> last (split (=='.') . pack . psName $ x) == s') getAllScripts
52+
where
53+
s' = pack $ takeBaseName s
4654

4755
encodePlutusScript ::
4856
ScriptInAnyLang

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCall.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -7,28 +7,28 @@
77

88
{-# OPTIONS_GHC -fno-warn-orphans #-}
99

10-
module Cardano.Benchmarking.PlutusScripts.CustomCall
11-
( scriptName
12-
, scriptSerialized
13-
) where
10+
module Cardano.Benchmarking.PlutusScripts.CustomCall (script) where
1411

1512
import Language.Haskell.TH
1613
import Language.Haskell.TH.Syntax
1714
import Prelude as Haskell (String, (.), (<$>))
1815

19-
import Cardano.Api (PlutusScript, PlutusScriptV2)
20-
import Cardano.Api.Shelley (PlutusScript (..))
16+
import Cardano.Api (PlutusScriptV2, toScriptInAnyLang, Script(..))
17+
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
2118
import qualified Data.ByteString.Short as SBS
2219
import qualified PlutusLedgerApi.V2 as PlutusV2
2320
import qualified PlutusTx
2421
import PlutusTx.Prelude as Plutus hiding (Semigroup (..), (.), (<$>))
2522

23+
import Cardano.Benchmarking.ScriptAPI
2624
import Cardano.Benchmarking.PlutusScripts.CustomCallTypes
2725

26+
script :: PlutusBenchScript
27+
script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
2828

2929
scriptName :: Haskell.String
3030
scriptName
31-
= $(LitE . StringL . loc_module <$> qLocation)
31+
= prepareScriptName $(LitE . StringL . loc_module <$> qLocation)
3232

3333

3434
instance Plutus.Eq CustomCallData where

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/EcdsaSecp256k1Loop.hs

+8-7
Original file line numberDiff line numberDiff line change
@@ -4,16 +4,14 @@
44
{-# LANGUAGE TypeApplications #-}
55
{-# LANGUAGE TypeFamilies #-}
66

7-
module Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop
8-
( scriptName
9-
, scriptSerialized
10-
) where
7+
module Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop (script) where
118

129
import Language.Haskell.TH
1310
import Language.Haskell.TH.Syntax
1411

15-
import Cardano.Api (PlutusScript, PlutusScriptV2)
16-
import Cardano.Api.Shelley (PlutusScript (..))
12+
import Cardano.Api (PlutusScript, PlutusScriptV2, Script(..), toScriptInAnyLang)
13+
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
14+
import Cardano.Benchmarking.ScriptAPI
1715
import qualified Data.ByteString.Short as SBS
1816
import qualified PlutusLedgerApi.V2 as PlutusV2
1917
import qualified PlutusTx
@@ -24,7 +22,10 @@ import Prelude as Haskell (String, (.), (<$>))
2422

2523
scriptName :: Haskell.String
2624
scriptName
27-
= $(LitE . StringL . loc_module <$> qLocation)
25+
= prepareScriptName $(LitE . StringL . loc_module <$> qLocation)
26+
27+
script :: PlutusBenchScript
28+
script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
2829

2930

3031
{-# INLINEABLE mkValidator #-}

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/Loop.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -4,17 +4,14 @@
44
{-# LANGUAGE TypeApplications #-}
55
{-# LANGUAGE TypeFamilies #-}
66

7-
module Cardano.Benchmarking.PlutusScripts.Loop
8-
( scriptName
9-
, scriptSerialized
10-
) where
7+
module Cardano.Benchmarking.PlutusScripts.Loop (script) where
118

129
import Language.Haskell.TH
1310
import Language.Haskell.TH.Syntax
1411
import Prelude hiding (pred, ($), (&&), (<), (==))
1512

16-
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
17-
13+
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1, Script(..), toScriptInAnyLang, PlutusScriptVersion(..))
14+
import Cardano.Benchmarking.ScriptAPI
1815
import qualified Data.ByteString.Short as SBS
1916

2017
import qualified PlutusLedgerApi.V2 as PlutusV2
@@ -25,7 +22,10 @@ import PlutusTx.Prelude hiding (Semigroup (..), unless, (.), (<$>))
2522

2623
scriptName :: String
2724
scriptName
28-
= $(LitE . StringL . loc_module <$> qLocation)
25+
= prepareScriptName $(LitE . StringL . loc_module <$> qLocation)
26+
27+
script :: PlutusBenchScript
28+
script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV1 scriptSerialized))
2929

3030

3131
{-# INLINABLE mkValidator #-}

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/SchnorrSecp256k1Loop.hs

+8-7
Original file line numberDiff line numberDiff line change
@@ -4,16 +4,14 @@
44
{-# LANGUAGE TypeApplications #-}
55
{-# LANGUAGE TypeFamilies #-}
66

7-
module Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop
8-
( scriptName
9-
, scriptSerialized
10-
) where
7+
module Cardano.Benchmarking.PlutusScripts.SchnorrSecp256k1Loop (script) where
118

129
import Language.Haskell.TH
1310
import Language.Haskell.TH.Syntax
1411

15-
import Cardano.Api (PlutusScript, PlutusScriptV2)
16-
import Cardano.Api.Shelley (PlutusScript (..))
12+
import Cardano.Api (PlutusScript, PlutusScriptV2, Script(..), toScriptInAnyLang)
13+
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptVersion (..))
14+
import Cardano.Benchmarking.ScriptAPI
1715
import qualified Data.ByteString.Short as SBS
1816
import qualified PlutusLedgerApi.V2 as PlutusV2
1917
import qualified PlutusTx
@@ -24,7 +22,10 @@ import Prelude as Haskell (String, (.), (<$>))
2422

2523
scriptName :: Haskell.String
2624
scriptName
27-
= $(LitE . StringL . loc_module <$> qLocation)
25+
= prepareScriptName $(LitE . StringL . loc_module <$> qLocation)
26+
27+
script :: PlutusBenchScript
28+
script = mkPlutusBenchScript scriptName (toScriptInAnyLang (PlutusScript PlutusScriptV2 scriptSerialized))
2829

2930

3031
{-# INLINEABLE mkValidator #-}

Diff for: ‎bench/plutus-scripts-bench/src/Cardano/Benchmarking/ScriptAPI.hs

+42
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
{-# OPTIONS_GHC -fno-warn-orphans #-}
2+
3+
module Cardano.Benchmarking.ScriptAPI
4+
( PlutusBenchScript
5+
, psName
6+
, psScript
7+
, mkPlutusBenchScript
8+
, prepareScriptName
9+
) where
10+
11+
import Prelude as Haskell (String, ($))
12+
import Data.Char (isUpper)
13+
import Data.Maybe (fromMaybe)
14+
import System.FilePath (splitExtension, stripExtension, takeFileName)
15+
import Cardano.Api (ScriptInAnyLang)
16+
17+
data PlutusBenchScript
18+
= PlutusBenchScript
19+
{ psName :: String
20+
, psScript :: ScriptInAnyLang
21+
}
22+
23+
mkPlutusBenchScript :: String -> ScriptInAnyLang -> PlutusBenchScript
24+
mkPlutusBenchScript = PlutusBenchScript
25+
26+
-- This is doing two or three sorts of normalisation at once:
27+
-- It strips leading / -separated components, drops the ".hs" suffix
28+
-- if present, then chooses the last . -separated component.
29+
-- If there is a suffix different from .hs that begins with a capital
30+
-- letter, that is returned.
31+
-- e.g. "Data/List/System.FilePath.Text.hs" --> "Text"
32+
-- "Data/List/System.FilePath.Text" --> "Text"
33+
prepareScriptName :: String -> String
34+
prepareScriptName script
35+
= case splitExtension file' of
36+
(s, "") -> s -- no dots so take it as-is
37+
(_, '.':s@(c:_)) | isUpper c -> s -- take last dot-separated component
38+
_ -> file' -- shouldn't happen
39+
where
40+
file = takeFileName script -- ignore leading directories
41+
-- no trailing .hs so use filename as-is
42+
file' = fromMaybe file $ stripExtension "hs" file

Diff for: ‎bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

+3-10
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ import Control.Monad.Trans.Except
2323
import Control.Monad.Trans.Except.Extra
2424
import "contra-tracer" Control.Tracer (nullTracer)
2525
import Data.ByteString.Lazy.Char8 as BSL (writeFile)
26-
import Data.List (isSuffixOf)
2726
import Data.Ratio ((%))
2827

2928
import Streaming
@@ -55,7 +54,6 @@ import Cardano.TxGenerator.Setup.SigningKey
5554

5655
import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile,
5756
makeLocalConnectInfo, protocolToCodecConfig)
58-
import Cardano.Benchmarking.PlutusScripts (findPlutusScript)
5957

6058
import Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_,
6159
btSubmission2_, btTxSubmit_)
@@ -409,12 +407,7 @@ makePlutusContext :: forall era. IsShelleyBasedEra era
409407
-> ActionM (Witness WitCtxTxIn era, ScriptInAnyLang, ScriptData, Lovelace)
410408
makePlutusContext ScriptSpec{..} = do
411409
protocolParameters <- getProtocolParameters
412-
script <- if ".hs" `isSuffixOf` scriptSpecFile
413-
then maybe
414-
(liftTxGenError $ TxGenError $ "Plutus script not included: " ++ scriptSpecFile)
415-
return
416-
(findPlutusScript scriptSpecFile)
417-
else liftIOSafe $ Plutus.readPlutusScript scriptSpecFile
410+
script <- liftIOSafe $ Plutus.readPlutusScript scriptSpecFile
418411

419412
executionUnitPrices <- case protocolParamPrices protocolParameters of
420413
Just x -> return x
@@ -458,15 +451,15 @@ makePlutusContext ScriptSpec{..} = do
458451
traceDebug $ "Plutus auto mode : Available budget per Tx: " ++ show perTxBudget
459452
++ " -- split between inputs per Tx: " ++ show txInputs
460453

461-
case plutusAutoScaleBlockfit protocolParameters scriptSpecFile script autoBudget strategy txInputs of
454+
case plutusAutoScaleBlockfit protocolParameters (either ("builtin: "++) ("plutus file: "++) scriptSpecFile) script autoBudget strategy txInputs of
462455
Left err -> liftTxGenError err
463456
Right (summary, PlutusAutoBudget{..}, preRun) -> do
464457
setEnvSummary summary
465458
dumpBudgetSummaryIfExisting
466459
return (unsafeHashableScriptData autoBudgetDatum, autoBudgetRedeemer, preRun)
467460

468461
let msg = mconcat [ "Plutus Benchmark :"
469-
, " Script: ", scriptSpecFile
462+
, " Script: ", show scriptSpecFile
470463
, ", Datum: ", show scriptData
471464
, ", Redeemer: ", show scriptRedeemer
472465
, ", StatedBudget: ", show executionUnits

Diff for: ‎bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ deriving instance Generic ScriptBudget
108108

109109
data ScriptSpec = ScriptSpec
110110
{
111-
scriptSpecFile :: !FilePath
111+
scriptSpecFile :: !(Either String FilePath)
112112
, scriptSpecBudget :: !ScriptBudget
113113
, scriptSpecPlutusType :: !TxGenPlutusType
114114
}

Diff for: ‎bench/tx-generator/src/Cardano/TxGenerator/Setup/Plutus.hs

+8-2
Original file line numberDiff line numberDiff line change
@@ -27,14 +27,20 @@ import Cardano.Ledger.Alonzo.TxInfo (exBudgetToExUnits)
2727
import qualified PlutusLedgerApi.V1 as PlutusV1
2828
import qualified PlutusLedgerApi.V2 as PlutusV2
2929

30+
import Cardano.Benchmarking.PlutusScripts(findPlutusScript)
3031
import Cardano.TxGenerator.Types
3132

3233

3334
type ProtocolVersion = (Int, Int)
3435

3536

36-
readPlutusScript :: FilePath -> IO (Either TxGenError ScriptInAnyLang)
37-
readPlutusScript fp
37+
readPlutusScript :: Either String FilePath -> IO (Either TxGenError ScriptInAnyLang)
38+
readPlutusScript (Left s)
39+
= pure
40+
$ maybe (Left . TxGenError $ "readPlutusScript: " ++ s ++ " not found.")
41+
Right
42+
(findPlutusScript s)
43+
readPlutusScript (Right fp)
3844
= runExceptT $ do
3945
script <- firstExceptT ApiError $
4046
readFileScriptInAnyLang fp

Diff for: ‎bench/tx-generator/src/Cardano/TxGenerator/Types.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ data TxGenPlutusType
9090
data TxGenPlutusParams
9191
= PlutusOn -- ^ Generate Plutus Txs for given script
9292
{ plutusType :: !TxGenPlutusType
93-
, plutusScript :: !FilePath -- ^ Path to the Plutus script
93+
, plutusScript :: !(Either String FilePath) -- ^ Path to the Plutus script
9494
, plutusDatum :: !(Maybe FilePath) -- ^ Datum passed to the Plutus script (JSON file in ScriptData schema)
9595
, plutusRedeemer :: !(Maybe FilePath) -- ^ Redeemer passed to the Plutus script (JSON file in ScriptData schema)
9696
, plutusExecMemory :: !(Maybe Natural) -- ^ Max. memory for ExecutionUnits (overriding corresponding protocol parameter)

Diff for: ‎bench/tx-generator/test/ApiTest.hs

+7-4
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@
1010

1111
module Main (main) where
1212

13+
import Control.Arrow
1314
import Control.Monad
1415
import Control.Monad.Trans.Except
1516
import Control.Monad.Trans.Except.Extra
@@ -155,7 +156,7 @@ checkPlutusLoop ::
155156
checkPlutusLoop (Just PlutusOn{..})
156157
= do
157158
script <- either (die . show) pure =<< readPlutusScript plutusScript
158-
putStrLn $ "--> Read plutus script: " ++ plutusScript
159+
putStrLn $ "--> Read plutus script: " ++ (id ||| id) plutusScript
159160
protocolParameters <- readProtocolParametersOrDie
160161

161162
let count = 1_792 -- arbitrary counter for a loop script; should respect mainnet limits
@@ -202,9 +203,11 @@ checkPlutusLoop (Just PlutusOn{..})
202203
mul :: Natural -> Double -> Natural
203204
mul n d = floor $ d * fromIntegral n
204205

205-
getRedeemerFile =
206-
let redeemerPath = (<.> ".redeemer.json") $ dropExtension $ takeFileName plutusScript
207-
in getDataFileName $ "data" </> redeemerPath
206+
getRedeemerFile
207+
= case plutusScript of
208+
Right file -> let redeemerPath = (<.> ".redeemer.json") $ dropExtension $ takeFileName file
209+
in getDataFileName $ "data" </> redeemerPath
210+
Left _ -> getDataFileName "data/loop.redeemer.json"
208211
checkPlutusLoop _
209212
= putStrLn "--> No plutus script defined."
210213

Diff for: ‎nix/nixos/tx-generator-service.nix

+6-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,12 @@ let
55
plutus = if (cfg.plutus.type or null) == null then null else
66
{
77
inherit (cfg.plutus) type;
8-
script = "${pkgs.plutus-scripts}/generated-plutus-scripts/${cfg.plutus.script}";
8+
## Basically do something like:
9+
## script = "${pkgs.plutus-scripts}/generated-plutus-scripts/${cfg.plutus.script}";
10+
## except for having to weave the Either through things
11+
## To refer to a plutus script file, do something like:
12+
## { Right = pkgs.plutus-scripts + "/generated-plutus-scripts/" + cfg.plutus.script; }
13+
script = { Left = cfg.plutus.script; };
914
redeemer = pkgs.writeText "plutus-redeemer.json" (__toJSON cfg.plutus.redeemer);
1015
datum = if cfg.plutus.datum == null then null else
1116
pkgs.writeText "plutus-datum.json" (__toJSON cfg.plutus.datum);

0 commit comments

Comments
 (0)