Skip to content

Commit 57e8fc4

Browse files
errfromerrfrom
committed
test(standing_bid): wip: add negative tests for NewBid redeemer
1 parent 53b0ca8 commit 57e8fc4

File tree

4 files changed

+224
-19
lines changed

4 files changed

+224
-19
lines changed

‎hydra-auction-onchain.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,7 @@ test-suite hydra-auction-onchain-test
168168
build-depends:
169169
, bytestring
170170
, cryptonite
171+
, data-default
171172
, hydra-auction-onchain
172173
, memory
173174
, plutarch
@@ -177,5 +178,6 @@ test-suite hydra-auction-onchain-test
177178
, pretty-simple
178179
, QuickCheck
179180
, tasty
181+
, tasty-expected-failure
180182
, tasty-quickcheck
181183
, text

‎test/Spec/HydraAuctionOnchain/Expectations.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,12 @@
11
module Spec.HydraAuctionOnchain.Expectations
22
( shouldFail
3+
, shouldFailWithError
34
, shouldSucceed
45
) where
56

7+
import Data.Text qualified as T (unpack)
68
import Data.Text.Lazy qualified as TL (unpack)
9+
import HydraAuctionOnchain.Types.Error (ErrorCode (toErrorCode))
710
import Plutarch (Script)
811
import Plutarch.Evaluate (evalScript)
912
import Test.Tasty.QuickCheck (Property, counterexample, property)
@@ -21,6 +24,24 @@ shouldFail script =
2124
where
2225
(result, _exUnits, logs) = evalScript script
2326

27+
shouldFailWithError :: ErrorCode e => e -> Script -> Property
28+
shouldFailWithError errExpected script =
29+
case result of
30+
Left _ | last logs == errCode -> property True
31+
Left _ ->
32+
counterexample ("Expected failure with error code " <> T.unpack errCode <> ".")
33+
. counterexample (showLogs logs)
34+
. property
35+
$ False
36+
Right _ ->
37+
counterexample "Expected failure, but succeeded instead."
38+
. counterexample (showLogs logs)
39+
. property
40+
$ False
41+
where
42+
errCode = toErrorCode errExpected
43+
(result, _exUnits, logs) = evalScript script
44+
2445
shouldSucceed :: Script -> Property
2546
shouldSucceed script =
2647
case result of

‎test/Spec/HydraAuctionOnchain/QuickCheck/Modifiers.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ import Test.QuickCheck (Arbitrary (arbitrary))
1515

1616
newtype GenNonAdaValue (mod :: Type -> Type) = GenNonAdaValue Value
1717
deriving stock (Show, Eq)
18+
deriving newtype (Semigroup, Monoid)
1819

1920
instance
2021
( Arbitrary (mod Integer)

‎test/Spec/HydraAuctionOnchain/Validators/StandingBid.hs‎

Lines changed: 200 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,10 @@
22

33
module Spec.HydraAuctionOnchain.Validators.StandingBid (spec) where
44

5+
import Data.Bool (bool)
6+
import Data.Default (Default (def))
57
import Data.List (singleton)
8+
import HydraAuctionOnchain.Errors.StandingBid (PStandingBidError (..))
69
import HydraAuctionOnchain.Scripts (compileScript)
710
import HydraAuctionOnchain.Validators.StandingBid (standingBidValidator)
811
import Plutarch (Script)
@@ -16,7 +19,7 @@ import PlutusLedgerApi.V2
1619
, Credential (ScriptCredential)
1720
, CurrencySymbol
1821
, Datum (Datum)
19-
, OutputDatum (OutputDatum)
22+
, OutputDatum (NoOutputDatum, OutputDatum)
2023
, Redeemer (Redeemer)
2124
, ScriptContext (..)
2225
, ScriptHash
@@ -30,7 +33,7 @@ import PlutusLedgerApi.V2
3033
, toData
3134
)
3235
import PlutusTx.AssocMap qualified as AMap (singleton)
33-
import Spec.HydraAuctionOnchain.Expectations (shouldSucceed)
36+
import Spec.HydraAuctionOnchain.Expectations (shouldFail, shouldFailWithError, shouldSucceed)
3437
import Spec.HydraAuctionOnchain.Helpers (mkStandingBidTokenValue)
3538
import Spec.HydraAuctionOnchain.QuickCheck.Gen
3639
( genKeyPair
@@ -40,29 +43,137 @@ import Spec.HydraAuctionOnchain.QuickCheck.Gen
4043
, genValidNewBidState
4144
, vkey
4245
)
46+
import Spec.HydraAuctionOnchain.QuickCheck.Modifiers (GenNonAdaValue (GenNonAdaValue))
4347
import Spec.HydraAuctionOnchain.Types.AuctionTerms (AuctionTerms, biddingPeriod)
4448
import Spec.HydraAuctionOnchain.Types.Redeemers (StandingBidRedeemer (NewBidRedeemer))
45-
import Spec.HydraAuctionOnchain.Types.StandingBidState (StandingBidState)
46-
import Test.QuickCheck (Arbitrary (arbitrary), Property)
49+
import Spec.HydraAuctionOnchain.Types.StandingBidState (StandingBidState (StandingBidState))
50+
import Test.QuickCheck (Arbitrary (arbitrary), NonZero (NonZero), Property, resize, suchThat)
4751
import Test.Tasty (TestTree, testGroup)
52+
53+
-- import Test.Tasty.ExpectedFailure (ignoreTest)
4854
import Test.Tasty.QuickCheck (testProperty)
4955

5056
spec :: TestTree
5157
spec =
52-
testGroup
53-
"StandingBid"
54-
[ testGroup
55-
"NewBidRedeemer"
56-
[ testProperty "Succeeds" prop_newBid_validInput_succeeds
58+
testGroup "StandingBid" $
59+
[ testGroup "NewBidRedeemer" $
60+
[ testProperty "Succeeds if transaction is valid" $
61+
prop_validInput_succeeds
62+
, testProperty "Fails if standing bid input does not exist" $
63+
prop_missingStandingBidInput_fails
64+
, testProperty "Fails if there are multiple standing bid inputs" $
65+
prop_multipleStandingBidInputs_fails
66+
, testProperty "Fails if standing bid input does not contain standing bid token" $
67+
prop_standingBidInputMissingToken_fails
68+
, testProperty "Fails if transaction mints or burns tokens" $
69+
prop_mintsBurnsValue_fails
70+
, testProperty "Fails if standing bid output does not exist" $
71+
prop_newBid_missingStandingBidOutput_fails
72+
, testProperty "Fails if there are multiple standing bid outputs" $
73+
prop_multipleStandingBidOutputs_fails
74+
, testProperty "Fails if standing bid output does not contain standing bid token" $
75+
prop_newBid_standingBidOutputMissingToken_fails
76+
, testProperty "Fails if new bid state datum is missing" $
77+
prop_newBid_missingNewBidStateDatum_fails
78+
, testProperty "Fails if new bid state datum is invalid" $
79+
prop_newBid_invalidNewBidStateDatum_fails
80+
, testProperty "Fails if new bid state is empty" $
81+
prop_newBid_emptyNewBidState_fails
5782
]
5883
]
5984

6085
--------------------------------------------------------------------------------
61-
-- NewBid
86+
-- NewBid Properties
6287
--------------------------------------------------------------------------------
6388

64-
prop_newBid_validInput_succeeds :: NewBidTestContext -> Property
65-
prop_newBid_validInput_succeeds testContext = shouldSucceed $ testNewBid testContext
89+
prop_validInput_succeeds :: NewBidTestContext -> Property
90+
prop_validInput_succeeds testContext =
91+
shouldSucceed $
92+
testNewBid testContext def
93+
94+
prop_missingStandingBidInput_fails :: NewBidTestContext -> Property
95+
prop_missingStandingBidInput_fails testContext =
96+
shouldFailWithError StandingBid'Error'MissingStandingBidInput $
97+
testNewBid testContext $
98+
def
99+
{ standingBidInputMode = StandingBidInputMissing
100+
}
101+
102+
prop_multipleStandingBidInputs_fails :: NewBidTestContext -> Property
103+
prop_multipleStandingBidInputs_fails testContext =
104+
shouldFailWithError StandingBid'Error'TooManyOwnScriptInputs $
105+
testNewBid testContext $
106+
def
107+
{ standingBidInputMode = MultipleStandingBidInputs
108+
}
109+
110+
prop_standingBidInputMissingToken_fails :: NewBidTestContext -> Property
111+
prop_standingBidInputMissingToken_fails testContext =
112+
shouldFailWithError StandingBid'Error'OwnInputMissingToken $
113+
testNewBid testContext $
114+
def
115+
{ standingBidInputContainsToken = False
116+
}
117+
118+
prop_mintsBurnsValue_fails :: NewBidTestContext -> Property
119+
prop_mintsBurnsValue_fails testContext =
120+
shouldFailWithError StandingBid'Error'UnexpectedTokensMintedBurned $
121+
testNewBid testContext $
122+
def
123+
{ mintsBurnsValue = True
124+
}
125+
126+
prop_newBid_missingStandingBidOutput_fails :: NewBidTestContext -> Property
127+
prop_newBid_missingStandingBidOutput_fails testContext =
128+
shouldFailWithError StandingBid'NewBid'Error'MissingOwnOutput $
129+
testNewBid testContext $
130+
def
131+
{ standingBidOutputMode = StandingBidOutputMissing
132+
}
133+
134+
prop_multipleStandingBidOutputs_fails :: NewBidTestContext -> Property
135+
prop_multipleStandingBidOutputs_fails testContext =
136+
shouldFailWithError StandingBid'NewBid'Error'MissingOwnOutput $
137+
testNewBid testContext $
138+
def
139+
{ standingBidOutputMode = MultipleStandingBidOutputs
140+
}
141+
142+
prop_newBid_standingBidOutputMissingToken_fails :: NewBidTestContext -> Property
143+
prop_newBid_standingBidOutputMissingToken_fails testContext =
144+
shouldFailWithError StandingBid'NewBid'Error'OwnOutputMissingToken $
145+
testNewBid testContext $
146+
def
147+
{ standingBidOutputContainsToken = False
148+
}
149+
150+
prop_newBid_missingNewBidStateDatum_fails :: NewBidTestContext -> Property
151+
prop_newBid_missingNewBidStateDatum_fails testContext =
152+
shouldFailWithError StandingBid'NewBid'Error'FailedToDecodeNewBid $
153+
testNewBid testContext $
154+
def
155+
{ newBidStateMode = NewBidStateMissingDatum
156+
}
157+
158+
prop_newBid_invalidNewBidStateDatum_fails :: NewBidTestContext -> Property
159+
prop_newBid_invalidNewBidStateDatum_fails testContext =
160+
shouldFail $
161+
testNewBid testContext $
162+
def
163+
{ newBidStateMode = NewBidStateInvalidDatum
164+
}
165+
166+
prop_newBid_emptyNewBidState_fails :: NewBidTestContext -> Property
167+
prop_newBid_emptyNewBidState_fails testContext =
168+
shouldFailWithError StandingBid'NewBid'Error'InvalidNewBidState $
169+
testNewBid testContext $
170+
def
171+
{ newBidStateMode = NewBidStateEmpty
172+
}
173+
174+
--------------------------------------------------------------------------------
175+
-- NewBid Test Context
176+
--------------------------------------------------------------------------------
66177

67178
data NewBidTestContext = NewBidTestContext
68179
{ auctionCs :: CurrencySymbol
@@ -72,6 +183,8 @@ data NewBidTestContext = NewBidTestContext
72183
, txInfoTemplate :: TxInfo
73184
, standingBidInputOref :: TxOutRef
74185
, scriptAddress :: Address
186+
, invalidNewBidStateDatum :: Datum
187+
, invalidMintValue :: Value
75188
}
76189
deriving stock (Show, Eq)
77190

@@ -85,10 +198,60 @@ instance Arbitrary NewBidTestContext where
85198
txInfoTemplate <- genTxInfoTemplate
86199
standingBidInputOref <- arbitrary @TxOutRef
87200
scriptAddress <- flip Address Nothing . ScriptCredential <$> arbitrary @ScriptHash
201+
invalidNewBidStateDatum <- resize 10 $ arbitrary @Datum
202+
GenNonAdaValue @NonZero invalidMintValue <- arbitrary `suchThat` ((/=) mempty)
88203
pure NewBidTestContext {..}
89204

90-
testNewBid :: NewBidTestContext -> Script
91-
testNewBid NewBidTestContext {..} =
205+
--------------------------------------------------------------------------------
206+
-- NewBid Test Constraints
207+
--------------------------------------------------------------------------------
208+
209+
data NewBidTestConstraints = NewBidTestConstraints
210+
{ standingBidInputMode :: StandingBidInputMode
211+
, standingBidInputContainsToken :: Bool
212+
, mintsBurnsValue :: Bool
213+
, standingBidOutputMode :: StandingBidOutputMode
214+
, standingBidOutputContainsToken :: Bool
215+
, newBidStateMode :: NewBidStateMode
216+
}
217+
deriving stock (Show, Eq)
218+
219+
instance Default NewBidTestConstraints where
220+
def =
221+
NewBidTestConstraints
222+
{ standingBidInputMode = StandingBidInputValid
223+
, standingBidInputContainsToken = True
224+
, mintsBurnsValue = False
225+
, standingBidOutputMode = StandingBidOutputValid
226+
, standingBidOutputContainsToken = True
227+
, newBidStateMode = NewBidStateValid
228+
}
229+
230+
data StandingBidInputMode
231+
= StandingBidInputValid
232+
| StandingBidInputMissing
233+
| MultipleStandingBidInputs
234+
deriving stock (Show, Eq)
235+
236+
data StandingBidOutputMode
237+
= StandingBidOutputValid
238+
| StandingBidOutputMissing
239+
| MultipleStandingBidOutputs
240+
deriving stock (Show, Eq)
241+
242+
data NewBidStateMode
243+
= NewBidStateValid
244+
| NewBidStateEmpty
245+
| NewBidStateMissingDatum
246+
| NewBidStateInvalidDatum
247+
deriving stock (Show, Eq)
248+
249+
--------------------------------------------------------------------------------
250+
-- NewBid Test
251+
--------------------------------------------------------------------------------
252+
253+
testNewBid :: NewBidTestContext -> NewBidTestConstraints -> Script
254+
testNewBid NewBidTestContext {..} NewBidTestConstraints {..} =
92255
let
93256
standingBidTokenValue :: Value
94257
standingBidTokenValue = mkStandingBidTokenValue auctionCs
@@ -98,7 +261,7 @@ testNewBid NewBidTestContext {..} =
98261
TxInInfo standingBidInputOref $
99262
TxOut
100263
{ txOutAddress = scriptAddress
101-
, txOutValue = standingBidTokenValue
264+
, txOutValue = bool mempty standingBidTokenValue standingBidInputContainsToken
102265
, txOutDatum = OutputDatum $ Datum $ dataToBuiltinData $ toData oldBidState
103266
, txOutReferenceScript = Nothing
104267
}
@@ -107,8 +270,17 @@ testNewBid NewBidTestContext {..} =
107270
standingBidOutput =
108271
TxOut
109272
{ txOutAddress = scriptAddress
110-
, txOutValue = standingBidTokenValue
111-
, txOutDatum = OutputDatum $ Datum $ dataToBuiltinData $ toData newBidState
273+
, txOutValue = bool mempty standingBidTokenValue standingBidOutputContainsToken
274+
, txOutDatum =
275+
case newBidStateMode of
276+
NewBidStateValid ->
277+
OutputDatum $ Datum $ dataToBuiltinData $ toData newBidState
278+
NewBidStateEmpty ->
279+
OutputDatum $ Datum $ dataToBuiltinData $ toData $ StandingBidState Nothing
280+
NewBidStateMissingDatum ->
281+
NoOutputDatum
282+
NewBidStateInvalidDatum ->
283+
OutputDatum invalidNewBidStateDatum
112284
, txOutReferenceScript = Nothing
113285
}
114286

@@ -126,8 +298,17 @@ testNewBid NewBidTestContext {..} =
126298
ScriptContext
127299
{ scriptContextTxInfo =
128300
txInfoTemplate
129-
{ txInfoInputs = singleton standingBidInput
130-
, txInfoOutputs = singleton standingBidOutput
301+
{ txInfoInputs =
302+
case standingBidInputMode of
303+
StandingBidInputValid -> singleton standingBidInput
304+
StandingBidInputMissing -> mempty
305+
MultipleStandingBidInputs -> replicate 2 standingBidInput
306+
, txInfoOutputs =
307+
case standingBidOutputMode of
308+
StandingBidOutputValid -> singleton standingBidOutput
309+
StandingBidOutputMissing -> mempty
310+
MultipleStandingBidOutputs -> replicate 2 standingBidOutput
311+
, txInfoMint = bool mempty invalidMintValue mintsBurnsValue
131312
, txInfoValidRange = biddingPeriod auctionTerms
132313
, txInfoRedeemers = AMap.singleton scriptPurpose redeemer
133314
}

0 commit comments

Comments
 (0)