diff --git a/agora-bench/Main.hs b/agora-bench/Main.hs index da9f79a..9acb2ab 100644 --- a/agora-bench/Main.hs +++ b/agora-bench/Main.hs @@ -19,12 +19,11 @@ import Prelude main :: IO () main = do I.writeFile "bench.csv" $ - (decodeUtf8 . encodeDefaultOrderedByName) $ - res + (decodeUtf8 . encodeDefaultOrderedByName) res - mapM_ print res + mapM_ print res where - res = + res = specificationTreeToBenchmarks $ group "Benchmark" diff --git a/agora-spec/Spec/Specification.hs b/agora-spec/Spec/Specification.hs index 37b512b..9570a30 100644 --- a/agora-spec/Spec/Specification.hs +++ b/agora-spec/Spec/Specification.hs @@ -57,7 +57,7 @@ import PlutusTx.IsData qualified as PlutusTx (ToData) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) -{-| Expectations upon execution of script +{- | Expectations upon execution of script @Success@ indicates a successful execution. @Failure@ inidcates a faulty execution. @FailureWith@ indicates a faulty execution but with expected reason for failure. @@ -68,7 +68,7 @@ data SpecificationExpectation | FailureWith String deriving stock (Show) -{-| Unit of specification. @Specification@ holds name, expectation, and +{- | Unit of specification. @Specification@ holds name, expectation, and script to be tested or executed later on. -} data Specification = Specification @@ -84,8 +84,9 @@ data SpecificationTree | Group String [SpecificationTree] deriving stock (Show) --- | Checks if given name exists in @SpecificationTree@ as either --- group name or specification name. +{- | Checks if given name exists in @SpecificationTree@ as either + group name or specification name. +-} exists :: String -> SpecificationTree -> Bool exists s (Terminal (Specification name _ _)) = s == name exists s (Group name st) = or (exists s <$> st) || s == name @@ -174,7 +175,7 @@ policySucceedsWith tag policy redeemer scriptContext = # pforgetData (pconstantData redeemer) # pconstant scriptContext ) - + -- | Check that a policy script fails, given a name and arguments. policyFailsWith :: ( PLift redeemer @@ -192,7 +193,7 @@ policyFailsWith tag policy redeemer scriptContext = # pforgetData (pconstantData redeemer) # pconstant scriptContext ) - + -- | Check that a validator script succeeds, given a name and arguments. validatorSucceedsWith :: ( PLift datum diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index ab750d1..030ae28 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -2,37 +2,8 @@ Module : Test.Util Maintainer : emi@haskell.fyi Description: Utility functions for testing Plutarch scripts with ScriptContext - -Utility functions for testing Plutarch scripts with ScriptContext: - - - 'policySucceedsWith': checks that a minting policy succeeds. - - - 'policyFailsWith': checks that a minting policy fails. - - - 'validatorSucceedsWith': checks that validator succeeds. - - - 'validatorFailsWith': checks that validator fails. - - - 'effectSucceedsWith': checks that effect succeeds. - - - 'effectFailsWith': checks that effect fails. - - - 'scriptSucceeds': checks that an arbitrary script does not - `perror`. - - - 'scriptFails': checks that an arbitrary script `perror`s out. -} module Test.Util ( - -- * Testing utils - scriptSucceeds, - scriptFails, - policySucceedsWith, - policyFailsWith, - validatorSucceedsWith, - validatorFailsWith, - effectSucceedsWith, - effectFailsWith, - -- * Plutus-land utils datumHash, toDatum, @@ -53,19 +24,9 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy -------------------------------------------------------------------------------- -import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertFailure, testCase) - --------------------------------------------------------------------------------- - -import Plutarch.Api.V1 (PMintingPolicy, PValidator) -import Plutarch.Builtin (pforgetData) import Plutarch.Crypto (pblake2b_256) -import Plutarch.Evaluate (evalScript) -import Plutarch.Lift (PUnsafeLiftDecl (PLifted)) -import Plutus.V1.Ledger.Contexts (ScriptContext) import Plutus.V1.Ledger.Interval as PlutusTx -import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script) +import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash)) import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.IsData qualified as PlutusTx @@ -73,140 +34,6 @@ import PlutusTx.Ord qualified as PlutusTx -------------------------------------------------------------------------------- --- | Check that a policy script succeeds, given a name and arguments. -policySucceedsWith :: - ( PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => - String -> - ClosedTerm PMintingPolicy -> - PLifted redeemer -> - ScriptContext -> - TestTree -policySucceedsWith tag policy redeemer scriptContext = - scriptSucceeds tag $ - compile - ( policy - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) - --- | Check that a policy script fails, given a name and arguments. -policyFailsWith :: - ( PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => - String -> - ClosedTerm PMintingPolicy -> - PLifted redeemer -> - ScriptContext -> - TestTree -policyFailsWith tag policy redeemer scriptContext = - scriptFails tag $ - compile - ( policy - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) - --- | Check that a validator script succeeds, given a name and arguments. -validatorSucceedsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - , PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => - String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> - ScriptContext -> - TestTree -validatorSucceedsWith tag validator datum redeemer scriptContext = - scriptSucceeds tag $ - compile - ( validator - # pforgetData (pconstantData datum) - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) - --- | Check that a validator script fails, given a name and arguments. -validatorFailsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - , PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => - String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> - ScriptContext -> - TestTree -validatorFailsWith tag validator datum redeemer scriptContext = - scriptFails tag $ - compile - ( validator - # pforgetData (pconstantData datum) - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) - -{- | Check that a validator script succeeds, given a name and arguments. - TODO: Change docstring. --} -effectSucceedsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - ) => - String -> - ClosedTerm PValidator -> - PLifted datum -> - ScriptContext -> - TestTree -effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum () - --- TODO: Change docstring. - -{- | Check that a validator script fails, given a name and arguments. - TODO: Change docstring. --} -effectFailsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - ) => - String -> - ClosedTerm PValidator -> - PLifted datum -> - ScriptContext -> - TestTree -effectFailsWith tag eff datum = validatorFailsWith tag eff datum () - --- | Check that an arbitrary script doesn't error when evaluated, given a name. -scriptSucceeds :: String -> Script -> TestTree -scriptSucceeds name script = testCase name $ do - let (res, _budget, traces) = evalScript script - case res of - Left e -> do - assertFailure $ - show e <> " Traces: " <> show traces - Right _v -> - pure () - --- | Check that an arbitrary script **does** error when evaluated, given a name. -scriptFails :: String -> Script -> TestTree -scriptFails name script = testCase name $ do - let (res, _budget, traces) = evalScript script - case res of - Left _e -> - pure () - Right v -> - assertFailure $ - "Expected failure, but succeeded. " <> show v <> " Traces: " <> show traces - --------------------------------------------------------------------------------- - {- | Create a pair from data for use in 'txInfoData'. Example: diff --git a/agora.cabal b/agora.cabal index 65ab99c..8797761 100644 --- a/agora.cabal +++ b/agora.cabal @@ -182,13 +182,13 @@ library agora-sample library agora-spec import: lang, deps, test-deps exposed-modules: - Spec.Specification Spec.AuthorityToken Spec.Effect.GovernorMutation Spec.Effect.TreasuryWithdrawal Spec.Governor Spec.Model.MultiSig Spec.Proposal + Spec.Specification Spec.Stake Spec.Treasury Spec.Utils