Merge pull request #26 from IntersectMBO/yura/issue-24-define-2-party-escrow

feat: define Two-Party Escrow benchmark scenario

Author: Unisay

README.md

@@ -83,9 +83,14 @@ cape benchmark list
 
 # View a specific benchmark
 cape benchmark fibonacci
+cape benchmark two-party-escrow
+
+# Generate JSON statistics for all benchmarks
+cape benchmark stats
 
 # Create a submission for your compiler
 cape submission new fibonacci MyCompiler 1.0.0 myhandle
+cape submission new two-party-escrow MyCompiler 1.0.0 myhandle
 ```
 
 ---
@@ -102,7 +107,7 @@ Latest benchmark reports: [UPLC-CAPE Reports](https://intersectmbo.github.io/UPL
 | --- | --- | --- | --- |
 | [Fibonacci](scenarios/fibonacci.md) | Synthetic | Recursive algorithm performance | Ready |
 | [Factorial](scenarios/factorial.md) | Synthetic | Recursive algorithm performance | Ready |
-| Two-Party Escrow | Real-world | Smart contract scenario | Planned |
+| [Two-Party Escrow](scenarios/two-party-escrow.md) | Real-world | Smart contract escrow validator | Ready |
 | Streaming Payments | Real-world | Payment channel implementation | Planned |
 | Simple DAO Voting | Real-world | Governance mechanism | Planned |
 | Time-locked Staking | Real-world | Staking protocol | Planned |
@@ -119,6 +124,7 @@ For the full and up-to-date command reference, see [USAGE.md](USAGE.md).
 # Benchmarks
 cape benchmark list              # List all benchmarks
 cape benchmark <name>            # Show benchmark details
+cape benchmark stats             # Generate JSON statistics for all benchmarks
 cape benchmark new <name>        # Create a new benchmark from template
 
 # Submissions
@@ -132,6 +138,23 @@ cape submission report <name>    # Generate HTML report for a benchmark
 cape submission report --all     # Generate HTML reports for all benchmarks
 ```
 
+### JSON Statistics
+
+The `cape benchmark stats` command generates comprehensive JSON data for all benchmarks:
+
+```zsh
+# Output JSON statistics to console
+cape benchmark stats
+
+# Save to file
+cape benchmark stats > stats.json
+
+# Use with jq for filtering
+cape benchmark stats | jq '.benchmarks[] | select(.submission_count > 0)'
+```
+
+The output includes formatted metrics, best value indicators, and submission metadata, making it ideal for generating custom reports or integrating with external tools.
+
 ### Interactive prompts
 
 ```zsh
@@ -275,14 +298,18 @@ cape submission new fibonacci    # Prompts for compiler, version, handle
 UPLC-CAPE/
 ├── scenarios/                    # Benchmark specifications
 │   ├── TEMPLATE/                 # Template for new scenarios
-│   └── fibonacci.md
+│   ├── fibonacci.md
+│   ├── factorial.md
+│   └── two-party-escrow.md
 ├── submissions/                  # Compiler submissions (per scenario)
 │   ├── TEMPLATE/                 # Templates and schemas
 │   │   ├── metadata.schema.json
 │   │   ├── metadata-template.json
 │   │   ├── metrics.schema.json
 │   │   └── metrics-template.json
-│   └── fibonacci/
+│   ├── fibonacci/
+│   │   └── MyCompiler_1.0.0_handle/
+│   └── two-party-escrow/
 │       └── MyCompiler_1.0.0_handle/
 ├── scripts/                      # Project CLI tooling
 │   ├── cape.sh                   # Main CLI

flake.lock

@@ -0,0 +1,60 @@
+module App.Cli (
+  Options (..),
+  parseOptions,
+) where
+
+import Options.Applicative
+import Prelude
+
+-- | CLI options
+-- -i: input UPLC file
+-- -o: output metrics.json file
+-- -v: optional verifier UPLC file (applied as (verifier submissionResult))
+-- -d: optional driver UPLC file for validator testing with overhead calculation
+data Options = Options
+  { optInput :: FilePath
+  , optOutput :: FilePath
+  , optVerifier :: Maybe FilePath
+  , optDriver :: Maybe FilePath
+  }
+
+optionsParser :: Parser Options
+optionsParser =
+  Options
+    <$> strOption
+      (long "input" <> short 'i' <> metavar "FILE" <> help "UPLC input file")
+    <*> strOption
+      ( long "output" <> short 'o' <> metavar "FILE" <> help "metrics.json output file"
+      )
+    <*> optional
+      ( strOption
+          ( long "verifier"
+              <> short 'v'
+              <> metavar "VERIFIER.uplc"
+              <> help
+                "Verifier UPLC file applied as (verifier submissionResult) for correctness verification"
+          )
+      )
+    <*> optional
+      ( strOption
+          ( long "driver"
+              <> short 'd'
+              <> metavar "DRIVER.uplc"
+              <> help
+                "Driver UPLC file for validator testing with overhead calculation"
+          )
+      )
+
+optsInfo :: ParserInfo Options
+optsInfo =
+  info
+    (optionsParser <**> helper)
+    ( fullDesc
+        <> progDesc
+          "Measure a UPLC program and optionally verify correctness using a provided verifier UPLC file or test validators using a driver UPLC file"
+        <> header "uplc-measure"
+    )
+
+-- | Parse command-line options
+parseOptions :: IO Options
+parseOptions = execParser optsInfo

measure/app/App/Cli.hs

@@ -0,0 +1,48 @@
+module App.Error (
+  MeasureError (..),
+  renderMeasureError,
+  exitCodeForError,
+) where
+
+import Control.Exception qualified as E
+import System.Exit (ExitCode (..))
+import Prelude
+
+-- | Custom exception types for business logic errors
+data MeasureError
+  = FileNotFoundError FilePath
+  | FileDecodeError FilePath
+  | UPLCParseError FilePath String
+  | EvaluationError String
+  | VerificationError String
+  | DriverError String
+  deriving stock (Show)
+
+instance E.Exception MeasureError where
+  displayException = renderMeasureError
+
+-- | Render MeasureError to user-friendly message
+renderMeasureError :: MeasureError -> String
+renderMeasureError err = case err of
+  FileNotFoundError path ->
+    "Error: File not found: " ++ path
+  FileDecodeError path ->
+    "Error: Failed to decode UTF-8 text: " ++ path
+  UPLCParseError path details ->
+    "Error: Malformed/invalid UPLC file: " ++ path ++ "\n" ++ details
+  EvaluationError details ->
+    "Error: Evaluation failed: " ++ details
+  VerificationError details ->
+    "Error: Verification failed: " ++ details
+  DriverError details ->
+    "Error: Driver operation failed: " ++ details
+
+-- | Get exit code for MeasureError
+exitCodeForError :: MeasureError -> ExitCode
+exitCodeForError err = case err of
+  FileNotFoundError _ -> ExitFailure 2
+  FileDecodeError _ -> ExitFailure 4
+  UPLCParseError _ _ -> ExitFailure 4
+  EvaluationError _ -> ExitFailure 3
+  VerificationError _ -> ExitFailure 2
+  DriverError _ -> ExitFailure 3

measure/app/App/Error.hs

@@ -0,0 +1,19 @@
+module App.Fixture (dummyValidator) where
+
+import PlutusCore qualified as PLC
+import PlutusCore.MkPlc (mkConstant)
+import UntypedPlutusCore qualified as UPLC
+import UntypedPlutusCore.Core.Type (Term (..))
+
+-- | Dummy validator UPLC program that ignores input and returns unit
+dummyValidator ::
+  UPLC.Program UPLC.Name PLC.DefaultUni PLC.DefaultFun PLC.SrcSpan
+dummyValidator =
+  let ann = PLC.SrcSpan "" 1 1 1 1
+      -- Create a lambda that ignores its input and returns unit constant
+      -- \(x : Data) -> ()
+      inputName = UPLC.Name "x" (PLC.Unique 0)
+      unitConstant = mkConstant ann ()
+      lambdaTerm = LamAbs ann inputName unitConstant
+      version = PLC.Version 1 1 0
+   in UPLC.Program ann version lambdaTerm

measure/app/App/Fixture.hs

@@ -1,16 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE Strict #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 --
 {-# OPTIONS_GHC -fno-full-laziness #-}
 {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
@@ -26,14 +14,15 @@
 {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:remove-trace #-}
 {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-}
 
-module Main where
+module Main (main) where
 
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import PlutusCore.Pretty qualified as PP
 import PlutusCore.Quote (runQuoteT)
 import PlutusTx qualified as Tx
+import PlutusTx.Builtins.Internal (unitval)
 import PlutusTx.Prelude
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
@@ -50,11 +39,36 @@ verifyEquals42 n = check (n == 42)
 verifyEquals42Compiled :: Tx.CompiledCode (Integer -> BuiltinUnit)
 verifyEquals42Compiled = $$(Tx.compile [||verifyEquals42||])
 
--- | Generate UPLC text for the verifier
-generateVerifierUPLC :: IO Text
-generateVerifierUPLC = do
-  let compiled = verifyEquals42Compiled
-      uplcProgramWithDeBruijn = Tx.getPlcNoAnn compiled
+-- | Dummy validator that always returns unit regardless of input
+dummyValidator :: BuiltinData -> BuiltinUnit
+dummyValidator _ = unitval
+
+-- | Compile the dummy validator to UPLC
+dummyValidatorCompiled :: Tx.CompiledCode (BuiltinData -> BuiltinUnit)
+dummyValidatorCompiled = $$(Tx.compile [||dummyValidator||])
+
+-- | Test validator for integration testing (accepts integer 42 as BuiltinData)
+testValidator :: BuiltinData -> BuiltinUnit
+testValidator input =
+  case Tx.fromBuiltinData input of
+    Just (42 :: Integer) -> unitval
+    _ -> traceError "Invalid input: expected 42"
+
+-- | Compile the test validator to UPLC
+testValidatorCompiled :: Tx.CompiledCode (BuiltinData -> BuiltinUnit)
+testValidatorCompiled = $$(Tx.compile [||testValidator||])
+
+-- | Generate UPLC text for the specified subject
+generateUPLC :: Text -> IO Text
+generateUPLC subject = do
+  uplcProgramWithDeBruijn <- case subject of
+    "equals42" -> return $ Tx.getPlcNoAnn verifyEquals42Compiled
+    "dummy-validator" -> return $ Tx.getPlcNoAnn dummyValidatorCompiled
+    "test-validator" -> return $ Tx.getPlcNoAnn testValidatorCompiled
+    _ -> do
+      putStrLn $ "Error: Unknown subject '" ++ Text.unpack subject ++ "'"
+      putStrLn "Available subjects: equals42, dummy-validator, test-validator"
+      exitFailure
 
   -- Convert DeBruijn names to regular names to be able to parse it
   -- using stock parser from the UntypedPlutusCore library.
@@ -74,23 +88,27 @@ generateVerifierUPLC = do
     P.Right prettyUplc ->
       P.return P.$ Text.pack P.$ show prettyUplc
 
--- | Write the verifier UPLC to a file
-writeVerifierToFile :: FilePath -> IO ()
-writeVerifierToFile filepath = do
-  uplcText <- generateVerifierUPLC
+-- | Write the UPLC program to a file
+writeUPLCToFile :: Text -> FilePath -> IO ()
+writeUPLCToFile subject filepath = do
+  uplcText <- generateUPLC subject
   Text.writeFile filepath uplcText
-  putStrLn P.$ "Verifier UPLC written to: " ++ filepath
+  putStrLn $ "UPLC program ("
+    ++ Text.unpack subject
+    ++ ") written to: "
+    ++ filepath
 
 main :: IO ()
 main = do
   args <- getArgs
   case args of
-    [filepath] -> writeVerifierToFile filepath
-    [] -> do
-      uplcText <- generateVerifierUPLC
+    [subject, filepath] -> writeUPLCToFile (Text.pack subject) filepath
+    [subject] -> do
+      uplcText <- generateUPLC (Text.pack subject)
       Text.putStrLn uplcText
     _ -> do
-      putStrLn "Usage: generate-verifiers [output-file]"
+      putStrLn "Usage: generate-verifiers <subject> [output-file]"
+      putStrLn "  subject: equals42, dummy-validator, test-validator"
       putStrLn "  Without output-file: prints UPLC to stdout"
-      putStrLn "  With output-file: writes UPLC to file"
+      putStrLn "  Subject parameter is required"
       exitFailure