Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve quickcheck-dynamic tests for CEM Script #113

Open
wants to merge 1 commit into
base: alexey/test-oura-filters
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 17 additions & 6 deletions example/CEM/Example/Auction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -133,12 +133,23 @@ instance CEMScript SimpleAuction where
)
cEmptyValue
)
, output
(userUtxo ctxParams.seller)
(cMinLovelace @<> cMkAdaOnlyValue buyoutBid.betAmount)
, output
(userUtxo buyoutBid.better)
(cMinLovelace @<> ctxParams.lot)
, if'
(ctxParams.seller `eq'` buyoutBid.better)
( output
(userUtxo ctxParams.seller)
(cMinLovelace @<> ctxParams.lot)
)
( output
(userUtxo buyoutBid.better)
(cMinLovelace @<> ctxParams.lot)
)
, if'
(ctxParams.seller `eq'` buyoutBid.better)
noop
( output
(userUtxo ctxParams.seller)
(cMinLovelace @<> cMkAdaOnlyValue buyoutBid.betAmount)
)
]
)
]
2 changes: 1 addition & 1 deletion src/Cardano/CEM/DSL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -298,7 +298,7 @@ getMainSigner cs = case mapMaybe f cs of
[pkh] -> pkh
_ ->
error
"Transition should have exactly one MainSignerCoinSelection constraint"
"Transition should have exactly one MainSigner* constraint"
where
f (MainSignerNoValue pkh) = Just pkh
f (MainSignerCoinSelect pkh _ _) = Just pkh
Expand Down
22 changes: 19 additions & 3 deletions src/Cardano/CEM/Smart.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,8 +19,8 @@ import Plutarch.Prelude (
(#&&),
)
import PlutusLedgerApi.V2 (PubKeyHash, ToData (..), Value)
import Prelude hiding (error)
import Prelude qualified (error)
import Prelude hiding (Eq, error)
import Prelude qualified (Eq, error)

-- -----------------------------------------------------------------------------
-- Helpers to be used in actual definitions
Expand Down Expand Up @@ -118,7 +118,7 @@ inState ::
inState spine = UnsafeUpdateOfSpine ctxState spine []

(@==) ::
(Eq x) => ConstraintDSL script x -> ConstraintDSL script x -> ConstraintDSL script Bool
(Prelude.Eq x) => ConstraintDSL script x -> ConstraintDSL script x -> ConstraintDSL script Bool
(@==) = Eq

(@<=) ::
Expand Down Expand Up @@ -254,3 +254,19 @@ match ::
Map (Spine datatype) (TxConstraint resolved script) ->
TxConstraint resolved script
match = MatchBySpine

if' ::
forall (resolved :: Bool) script.
DSLPattern resolved script Bool ->
TxConstraint resolved script ->
TxConstraint resolved script ->
TxConstraint resolved script
if' = If

eq' ::
forall x script.
(Prelude.Eq x) =>
ConstraintDSL script x ->
ConstraintDSL script x ->
ConstraintDSL script Bool
eq' = Eq
Loading
Loading