-
Notifications
You must be signed in to change notification settings - Fork 721
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
plutus-scripts-bench: migrate scripts into project
- Loading branch information
Showing
12 changed files
with
309 additions
and
177 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
81 changes: 81 additions & 0 deletions
81
bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCall.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,81 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE ImportQualifiedPost #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
|
|
||
| {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
|
|
||
| module Cardano.Benchmarking.PlutusScripts.CustomCall | ||
| ( scriptName | ||
| , scriptSerialized | ||
| ) 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 Codec.Serialise (serialise) | ||
| import qualified Data.ByteString.Lazy as LBS | ||
| import qualified Data.ByteString.Short as SBS | ||
| import qualified Plutus.V2.Ledger.Api as PlutusV2 | ||
| import qualified PlutusTx | ||
| import PlutusTx.Prelude as Plutus hiding (Semigroup (..), (.), (<$>)) | ||
|
|
||
| import Cardano.Benchmarking.PlutusScripts.CustomCallTypes | ||
|
|
||
|
|
||
| scriptName :: Haskell.String | ||
| scriptName | ||
| = $(LitE . StringL . loc_module <$> qLocation) | ||
|
|
||
|
|
||
| instance Plutus.Eq CustomCallData where | ||
| CCNone == CCNone = True | ||
| CCInteger i == CCInteger i' = i == i' | ||
| CCSum i is == CCSum i' is' = i == i' && is == is' | ||
| CCByteString s == CCByteString s' = s == s' | ||
| CCConcat s ss == CCConcat s' ss' = s == s' && ss == ss' | ||
| _ == _ = False | ||
|
|
||
| {-# INLINEABLE mkValidator #-} | ||
| mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> () | ||
| mkValidator datum_ redeemer_ _txContext = | ||
| let | ||
| result = case cmd of | ||
| EvalSpine -> length redeemerArg == length datumArg | ||
| EvalValues -> redeemerArg == datumArg | ||
| EvalAndValidate -> all validateValue redeemerArg && redeemerArg == datumArg | ||
| in if result then () else error () | ||
| where | ||
| datum, redeemer :: CustomCallArg | ||
| datum = unwrap datum_ | ||
| redeemer = unwrap redeemer_ | ||
|
|
||
| datumArg = snd datum | ||
| (cmd, redeemerArg) = redeemer | ||
|
|
||
| validateValue :: CustomCallData -> Bool | ||
| validateValue (CCSum i is) = i == sum is | ||
| validateValue (CCConcat s ss) = s == mconcat ss | ||
| validateValue _ = True | ||
|
|
||
| {-# INLINEABLE unwrap #-} | ||
| unwrap :: BuiltinData -> CustomCallArg | ||
| unwrap = PlutusV2.unsafeFromBuiltinData | ||
| -- Note: type-constraining unsafeFromBuiltinData decreases script's execution units. | ||
|
|
||
| validator :: PlutusV2.Validator | ||
| validator = PlutusV2.mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) | ||
|
|
||
| script :: PlutusV2.Script | ||
| script = PlutusV2.unValidatorScript validator | ||
|
|
||
| customCallScriptShortBs :: SBS.ShortByteString | ||
| customCallScriptShortBs = SBS.toShort . LBS.toStrict $ serialise script | ||
|
|
||
| scriptSerialized :: PlutusScript PlutusScriptV2 | ||
| scriptSerialized = PlutusScriptSerialised customCallScriptShortBs |
36 changes: 36 additions & 0 deletions
36
bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/CustomCallTypes.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,36 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE ImportQualifiedPost #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
|
|
||
| module Cardano.Benchmarking.PlutusScripts.CustomCallTypes | ||
| where | ||
|
|
||
| import qualified PlutusTx | ||
| import PlutusTx.Prelude as Plutus hiding (Semigroup (..), (.)) | ||
| import Prelude as Haskell (Eq, Show) | ||
|
|
||
|
|
||
| -- this alias describes what the CustomCall script | ||
| -- expects both as datum and as redeemer | ||
| type CustomCallArg = (CustomCallCommand, [CustomCallData]) | ||
|
|
||
| data CustomCallCommand | ||
| = EvalSpine | ||
| | EvalValues | ||
| | EvalAndValidate | ||
| deriving (Haskell.Eq, Haskell.Show) | ||
|
|
||
| data CustomCallData | ||
| = CCNone | ||
| | CCInteger Integer | ||
| | CCByteString BuiltinByteString | ||
| | CCSum Integer [Integer] | ||
| | CCConcat BuiltinByteString [BuiltinByteString] | ||
| deriving (Haskell.Eq, Haskell.Show) | ||
|
|
||
|
|
||
| PlutusTx.unstableMakeIsData ''CustomCallCommand | ||
| PlutusTx.unstableMakeIsData ''CustomCallData |
57 changes: 57 additions & 0 deletions
57
bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/EcdsaSecp256k1Loop.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,57 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
|
|
||
| module Cardano.Benchmarking.PlutusScripts.EcdsaSecp256k1Loop | ||
| ( scriptName | ||
| , scriptSerialized | ||
| ) where | ||
|
|
||
| import Language.Haskell.TH | ||
| import Language.Haskell.TH.Syntax | ||
|
|
||
| import Cardano.Api (PlutusScript, PlutusScriptV2) | ||
| import Cardano.Api.Shelley (PlutusScript (..)) | ||
| import Codec.Serialise (serialise) | ||
| import qualified Data.ByteString.Lazy as LBS | ||
| import qualified Data.ByteString.Short as SBS | ||
| import qualified Plutus.V2.Ledger.Api as PlutusV2 | ||
| import qualified PlutusTx | ||
| import qualified PlutusTx.Builtins as BI | ||
| import PlutusTx.Prelude as P hiding (Semigroup (..), (.), (<$>)) | ||
| import Prelude as Haskell (String, (.), (<$>)) | ||
|
|
||
|
|
||
| scriptName :: Haskell.String | ||
| scriptName | ||
| = $(LitE . StringL . loc_module <$> qLocation) | ||
|
|
||
|
|
||
| {-# INLINEABLE mkValidator #-} | ||
| mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> () | ||
| mkValidator _datum red _txContext = | ||
| case PlutusV2.fromBuiltinData red of | ||
| Nothing -> P.traceError "Trace error: Invalid redeemer" | ||
| Just (n, vkey, msg, sig) -> | ||
| if n < (1000000 :: Integer) -- large number ensures same bitsize for all counter values | ||
| then traceError "redeemer is < 1000000" | ||
| else loop n vkey msg sig | ||
| where | ||
| loop i v m s | ||
| | i == 1000000 = () | ||
| | BI.verifyEcdsaSecp256k1Signature v m s = loop (pred i) v m s | ||
| | otherwise = P.traceError "Trace error: ECDSA validation failed" | ||
|
|
||
| validator :: PlutusV2.Validator | ||
| validator = PlutusV2.mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||]) | ||
|
|
||
| script :: PlutusV2.Script | ||
| script = PlutusV2.unValidatorScript validator | ||
|
|
||
| v2EcdsaLoopScriptShortBs :: SBS.ShortByteString | ||
| v2EcdsaLoopScriptShortBs = SBS.toShort . LBS.toStrict $ serialise script | ||
|
|
||
| scriptSerialized :: PlutusScript PlutusScriptV2 | ||
| scriptSerialized = PlutusScriptSerialised v2EcdsaLoopScriptShortBs |
30 changes: 15 additions & 15 deletions
30
bench/plutus-scripts-bench/src/Cardano/Benchmarking/PlutusScripts/Loop.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.