removed redundant codes
This commit is contained in:
parent
32f6db5a66
commit
cde96df6a3
4 changed files with 12 additions and 185 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue