removed redundant codes

This commit is contained in:
Seungheon Oh 2022-05-25 11:57:11 -05:00
parent 32f6db5a66
commit cde96df6a3
No known key found for this signature in database
GPG key ID: 9B0E12D357369B66
4 changed files with 12 additions and 185 deletions

View file

@ -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"

View file

@ -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

View file

@ -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:

View file

@ -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