Skip to content

Commit f0b5700

Browse files
UnisayUnisay
committed
Dedicated executable to evaluate script from CLI
1 parent a0eb3e7 commit f0b5700

File tree

3 files changed

+214
-0
lines changed

3 files changed

+214
-0
lines changed

‎plutus-script-evaluation/evaluate-script/Main.hs

+89
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
module Main where
2+
3+
import Codec.Serialise (deserialiseOrFail)
4+
import Control.Error (note)
5+
import Control.Monad.Trans.Except (runExcept)
6+
import Control.Monad.Trans.Writer (runWriterT)
7+
import Data.Bifunctor (bimap)
8+
import Data.ByteString (ByteString)
9+
import Data.ByteString.Base16 qualified as Base16
10+
import Data.ByteString.Lazy qualified as BSL
11+
import Data.ByteString.Short qualified as BSS
12+
import Data.Function ((&))
13+
import Data.Int (Int64)
14+
import Main.Utf8 (withUtf8)
15+
import Options (Options (..), parserInfo)
16+
import Options.Applicative (execParser)
17+
import PlutusCore.Data (Data)
18+
import PlutusLedgerApi.Common (
19+
ExBudget (..),
20+
PlutusLedgerLanguage (..),
21+
VerboseMode (Quiet),
22+
deserialiseScript,
23+
evaluateScriptRestricting,
24+
)
25+
import PlutusLedgerApi.V1 qualified as V1
26+
import PlutusLedgerApi.V2 qualified as V2
27+
import PlutusLedgerApi.V3 qualified as V3
28+
import System.Exit (exitFailure)
29+
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdin, stdout)
30+
import Text.Read (readMaybe)
31+
32+
main :: IO ()
33+
main = withUtf8 do
34+
hSetBuffering stdin LineBuffering
35+
hSetBuffering stdout LineBuffering
36+
Options{..} <- execParser parserInfo
37+
result <- either reportError pure do
38+
scriptContext <- hexToBuiltinData scriptContextHex
39+
datum <- hexToBuiltinData datumHex
40+
redeemer <- hexToBuiltinData redeemerHex
41+
scriptForEvaluation <- do
42+
(BSS.toShort -> script) <- Base16.decode scriptHex
43+
deserialiseScript plutusLedgerLanguage majorProtocolVersion script
44+
& either (Left . show) pure
45+
costModelParams <- note "Failed to parse cost model" $ readMaybe costModel
46+
evaluationContext <- mkEvalCtx plutusLedgerLanguage costModelParams
47+
pure $
48+
evaluateScriptRestricting
49+
plutusLedgerLanguage
50+
majorProtocolVersion
51+
Quiet
52+
evaluationContext
53+
(ExBudget maxBound maxBound)
54+
scriptForEvaluation
55+
[datum, redeemer, scriptContext]
56+
57+
case snd result of
58+
Left err -> do
59+
print err
60+
putStr "Logs: "
61+
print $ fst result
62+
Right ExBudget{..} -> do
63+
putStrLn "Evaluation succeeded"
64+
print exBudgetCPU
65+
print exBudgetMemory
66+
67+
mkEvalCtx
68+
:: PlutusLedgerLanguage
69+
-> [Int64]
70+
-> Either String V3.EvaluationContext
71+
mkEvalCtx plutusLedgerLanguage costModelParams =
72+
bimap show fst . runExcept . runWriterT $
73+
case plutusLedgerLanguage of
74+
PlutusV1 -> V1.mkEvaluationContext costModelParams
75+
PlutusV2 -> V2.mkEvaluationContext costModelParams
76+
PlutusV3 -> V3.mkEvaluationContext costModelParams
77+
78+
hexToBuiltinData :: ByteString -> Either String Data
79+
hexToBuiltinData hex = do
80+
bytes <- Base16.decode hex
81+
case deserialiseOrFail (BSL.fromStrict bytes) of
82+
Left err -> Left (show err)
83+
Right bd -> Right bd
84+
85+
reportError :: String -> IO a
86+
reportError err = do
87+
putStrLn "Error:"
88+
putStrLn err
89+
exitFailure

‎plutus-script-evaluation/evaluate-script/Options.hs

+108
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
1+
{-# LANGUAGE ApplicativeDo #-}
2+
{-# LANGUAGE StrictData #-}
3+
4+
module Options (
5+
Options (..),
6+
options,
7+
parserInfo,
8+
)
9+
where
10+
11+
import Data.ByteString (ByteString)
12+
import Options.Applicative qualified as O
13+
import PlutusLedgerApi.Common (MajorProtocolVersion (..), PlutusLedgerLanguage (..))
14+
import PlutusLedgerApi.Common.Versions (knownPVs)
15+
import Text.Read (readMaybe)
16+
17+
data Options = Options
18+
{ scriptContextHex :: ByteString -- hex-encoded script context
19+
, datumHex :: ByteString -- hex-encoded datum
20+
, redeemerHex :: ByteString -- hex-encoded redeemer
21+
, scriptHex :: ByteString -- hex-encoded script
22+
, costModel :: String -- cost model parameter values "[1, 2, 3]"
23+
, plutusLedgerLanguage :: PlutusLedgerLanguage
24+
, majorProtocolVersion :: MajorProtocolVersion
25+
}
26+
deriving (Show)
27+
28+
options :: O.Parser Options
29+
options = do
30+
scriptContextHex <-
31+
O.strOption
32+
( mconcat
33+
[ O.long "script-context-hex"
34+
, O.metavar "SCRIPT_CONTEXT_HEX"
35+
, O.help "Hex-encoded script context"
36+
]
37+
)
38+
datumHex <-
39+
O.strOption
40+
( mconcat
41+
[ O.long "datum-hex"
42+
, O.metavar "DATUM_HEX"
43+
, O.help "Hex-encoded datum"
44+
]
45+
)
46+
redeemerHex <-
47+
O.strOption
48+
( mconcat
49+
[ O.long "redeemer-hex"
50+
, O.metavar "REDEEMER_HEX"
51+
, O.help "Hex-encoded redeemer"
52+
]
53+
)
54+
scriptHex <-
55+
O.strOption
56+
( mconcat
57+
[ O.long "script-hex"
58+
, O.metavar "SCRIPT_HEX"
59+
, O.help "Hex-encoded script"
60+
]
61+
)
62+
costModel <-
63+
O.strOption
64+
( mconcat
65+
[ O.short 'c'
66+
, O.long "cost-model"
67+
, O.metavar "COST_MODEL"
68+
, O.help "Cost model parameter values \"[1, 2, 3]\""
69+
]
70+
)
71+
plutusLedgerLanguage <-
72+
O.option
73+
(O.eitherReader readPlutusLedgerLanguage)
74+
( mconcat
75+
[ O.short 'l'
76+
, O.long "plutus-ledger-language"
77+
, O.metavar "PLUTUS_LEDGER_LANGUAGE"
78+
, O.help "Plutus ledger language"
79+
]
80+
)
81+
majorProtocolVersion <-
82+
O.option
83+
(O.eitherReader readMajorProtocolVersion)
84+
( mconcat
85+
[ O.short 'p'
86+
, O.long "major-protocol-version"
87+
, O.metavar "MAJOR_PROTOCOL_VERSION"
88+
, O.help "Major protocol version"
89+
]
90+
)
91+
pure Options{..}
92+
93+
readMajorProtocolVersion :: String -> Either String MajorProtocolVersion
94+
readMajorProtocolVersion s =
95+
case MajorProtocolVersion <$> readMaybe @Int s of
96+
Just mpv | mpv `elem` knownPVs -> Right mpv
97+
_ -> Left "Invalid Major Protocol Version, must be a number"
98+
99+
readPlutusLedgerLanguage :: String -> Either String PlutusLedgerLanguage
100+
readPlutusLedgerLanguage s =
101+
case readMaybe @Int s of
102+
Just 1 -> Right PlutusV1
103+
Just 2 -> Right PlutusV2
104+
Just 3 -> Right PlutusV3
105+
_ -> Left "Invalid Plutus Ledger Language, must be a number {1, 2, 3}"
106+
107+
parserInfo :: O.ParserInfo Options
108+
parserInfo = O.info (options O.<**> O.helper) mempty

‎plutus-script-evaluation/plutus-script-evaluation.cabal

+17
Original file line numberDiff line numberDiff line change
@@ -165,3 +165,20 @@ executable evaluate-scripts
165165
, cardano-slotting
166166
, text
167167
, unliftio-core
168+
169+
executable evaluate-script
170+
import: lang, deps-exe
171+
hs-source-dirs: evaluate-script
172+
main-is: Main.hs
173+
other-modules: Options
174+
build-depends:
175+
, base16-bytestring
176+
, cardano-api ^>=10.4
177+
, cardano-slotting
178+
, errors
179+
, plutus-core
180+
, plutus-ledger-api
181+
, serialise
182+
, text
183+
, transformers
184+
, unliftio-core

0 commit comments

Comments
 (0)