Skip to content

Commit 784a696

Browse files
errfromerrfrom
committed
test(standing_bid): wip: add property tests
1 parent dd8aad1 commit 784a696

File tree

9 files changed

+250
-5
lines changed

9 files changed

+250
-5
lines changed

‎hydra-auction-onchain.cabal‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -154,13 +154,19 @@ test-suite hydra-auction-onchain-test
154154
hs-source-dirs: test
155155
main-is: Spec.hs
156156
other-modules:
157+
Spec.HydraAuctionOnchain.Gen
157158
Spec.HydraAuctionOnchain.Helpers
158159
Spec.HydraAuctionOnchain.Types.AuctionTerms
160+
Spec.HydraAuctionOnchain.Types.BidderInfo
161+
Spec.HydraAuctionOnchain.Types.BidTerms
162+
Spec.HydraAuctionOnchain.Types.Redeemers
163+
Spec.HydraAuctionOnchain.Types.StandingBidState
159164
Spec.HydraAuctionOnchain.Validators.StandingBid
160165

161166
build-depends:
162167
, hydra-auction-onchain
163168
, plutarch
169+
, plutarch-quickcheck
164170
, plutus-ledger-api
165171
, plutus-tx
166172
, pretty-simple

‎src/HydraAuctionOnchain/Validators/StandingBid.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
{-# LANGUAGE TemplateHaskell #-}
22

33
module HydraAuctionOnchain.Validators.StandingBid
4-
( standingBidValidator
4+
( PStandingBidRedeemer (NewBidRedeemer, MoveToHydraRedeemer, ConcludeAuctionRedeemer)
5+
, standingBidValidator
56
) where
67

78
import HydraAuctionOnchain.Errors.StandingBid (PStandingBidError (..))

‎test/Spec/HydraAuctionOnchain/Gen.hs‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
module Spec.HydraAuctionOnchain.Gen
2+
( genTxInfoTemplate
3+
) where
4+
5+
import Plutarch.Test.QuickCheck.Instances ()
6+
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
7+
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
8+
import PlutusLedgerApi.V2 (TxId, TxInfo (..), adaSymbol, adaToken)
9+
import PlutusTx.AssocMap qualified as AMap (empty)
10+
import Test.QuickCheck (Gen, arbitrary)
11+
12+
genTxInfoTemplate :: Gen TxInfo
13+
genTxInfoTemplate = do
14+
txInfoFeeAda <- arbitrary @Integer
15+
txInfoId <- arbitrary @TxId
16+
pure $
17+
TxInfo
18+
{ txInfoInputs = mempty
19+
, txInfoReferenceInputs = mempty
20+
, txInfoOutputs = mempty
21+
, txInfoFee = Value.singleton adaSymbol adaToken txInfoFeeAda
22+
, txInfoMint = mempty
23+
, txInfoDCert = mempty
24+
, txInfoWdrl = AMap.empty
25+
, txInfoValidRange = Interval.always
26+
, txInfoSignatories = mempty
27+
, txInfoRedeemers = AMap.empty
28+
, txInfoData = AMap.empty
29+
, txInfoId
30+
}

‎test/Spec/HydraAuctionOnchain/Helpers.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module Spec.HydraAuctionOnchain.Helpers
22
( shouldFail
3+
, shouldSucceed
34
) where
45

56
import Data.Text.Lazy qualified as TL (unpack)
@@ -20,6 +21,19 @@ shouldFail script =
2021
where
2122
(result, _exUnits, logs) = evalScript script
2223

24+
shouldSucceed :: Script -> Property
25+
shouldSucceed script =
26+
case result of
27+
Left err ->
28+
counterexample "Expected success, but failed instead."
29+
. counterexample ("Error: " <> show err)
30+
. counterexample (showLogs logs)
31+
. property
32+
$ False
33+
Right _ -> property True
34+
where
35+
(result, _exUnits, logs) = evalScript script
36+
2337
showLogs :: Show a => [a] -> String
2438
showLogs = \case
2539
[] -> "No logs found. Did you forget to compile with tracing on?"

‎test/Spec/HydraAuctionOnchain/Types/BidTerms.hs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE UndecidableInstances #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
4+
5+
module Spec.HydraAuctionOnchain.Types.BidTerms
6+
( BidTerms (..)
7+
) where
8+
9+
import HydraAuctionOnchain.Types.BidTerms (PBidTerms)
10+
import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData))
11+
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
12+
import PlutusLedgerApi.V2 (BuiltinByteString)
13+
import PlutusTx (makeIsDataIndexed)
14+
import Spec.HydraAuctionOnchain.Types.BidderInfo (BidderInfo)
15+
16+
data BidTerms = BidTerms
17+
{ bt'Bidder :: BidderInfo
18+
, bt'BidPrice :: Integer
19+
, bt'BidderSignature :: BuiltinByteString
20+
, bt'SellerSignature :: BuiltinByteString
21+
}
22+
deriving stock (Show, Eq)
23+
24+
makeIsDataIndexed ''BidTerms [('BidTerms, 0)]
25+
26+
deriving via
27+
(DerivePConstantViaData BidTerms PBidTerms)
28+
instance
29+
(PConstantDecl BidTerms)
30+
31+
instance PUnsafeLiftDecl PBidTerms where
32+
type PLifted PBidTerms = BidTerms

‎test/Spec/HydraAuctionOnchain/Types/BidderInfo.hs‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE UndecidableInstances #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
4+
5+
module Spec.HydraAuctionOnchain.Types.BidderInfo
6+
( BidderInfo (..)
7+
) where
8+
9+
import HydraAuctionOnchain.Types.BidderInfo (PBidderInfo)
10+
import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData))
11+
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
12+
import PlutusLedgerApi.V2 (BuiltinByteString, PubKeyHash)
13+
import PlutusTx (makeIsDataIndexed)
14+
15+
data BidderInfo = BidderInfo
16+
{ bi'BidderPkh :: PubKeyHash
17+
, bi'BidderVk :: BuiltinByteString
18+
}
19+
deriving stock (Show, Eq)
20+
21+
makeIsDataIndexed ''BidderInfo [('BidderInfo, 0)]
22+
23+
deriving via
24+
(DerivePConstantViaData BidderInfo PBidderInfo)
25+
instance
26+
(PConstantDecl BidderInfo)
27+
28+
instance PUnsafeLiftDecl PBidderInfo where
29+
type PLifted PBidderInfo = BidderInfo

‎test/Spec/HydraAuctionOnchain/Types/Redeemers.hs‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE UndecidableInstances #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
4+
5+
module Spec.HydraAuctionOnchain.Types.Redeemers
6+
( StandingBidRedeemer (NewBidRedeemer, MoveToHydraRedeemer, ConcludeAuctionRedeemer)
7+
) where
8+
9+
import HydraAuctionOnchain.Validators.StandingBid (PStandingBidRedeemer)
10+
import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData))
11+
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
12+
import PlutusTx (makeIsDataIndexed)
13+
14+
--------------------------------------------------------------------------------
15+
-- Standing bid validator
16+
--------------------------------------------------------------------------------
17+
18+
data StandingBidRedeemer
19+
= NewBidRedeemer
20+
| MoveToHydraRedeemer
21+
| ConcludeAuctionRedeemer
22+
deriving stock (Show, Eq)
23+
24+
makeIsDataIndexed
25+
''StandingBidRedeemer
26+
[ ('NewBidRedeemer, 0)
27+
, ('MoveToHydraRedeemer, 1)
28+
, ('ConcludeAuctionRedeemer, 2)
29+
]
30+
31+
deriving via
32+
(DerivePConstantViaData StandingBidRedeemer PStandingBidRedeemer)
33+
instance
34+
(PConstantDecl StandingBidRedeemer)
35+
36+
instance PUnsafeLiftDecl PStandingBidRedeemer where
37+
type PLifted PStandingBidRedeemer = StandingBidRedeemer

‎test/Spec/HydraAuctionOnchain/Types/StandingBidState.hs‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
{-# LANGUAGE UndecidableInstances #-}
3+
{-# OPTIONS_GHC -Wno-orphans #-}
4+
5+
module Spec.HydraAuctionOnchain.Types.StandingBidState
6+
( StandingBidState (StandingBidState)
7+
) where
8+
9+
import HydraAuctionOnchain.Types.StandingBidState (PStandingBidState)
10+
import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData))
11+
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
12+
import PlutusTx.IsData.Class (FromData, ToData)
13+
import Spec.HydraAuctionOnchain.Types.BidTerms (BidTerms)
14+
15+
newtype StandingBidState = StandingBidState (Maybe BidTerms)
16+
deriving stock (Show, Eq)
17+
deriving newtype (FromData, ToData)
18+
19+
deriving via
20+
(DerivePConstantViaData StandingBidState PStandingBidState)
21+
instance
22+
(PConstantDecl StandingBidState)
23+
24+
instance PUnsafeLiftDecl PStandingBidState where
25+
type PLifted PStandingBidState = StandingBidState

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

Lines changed: 75 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,36 +1,107 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
13
module Spec.HydraAuctionOnchain.Validators.StandingBid (spec) where
24

5+
import Data.List (singleton)
36
import HydraAuctionOnchain.Scripts (compileScript)
47
import HydraAuctionOnchain.Validators.StandingBid (standingBidValidator)
58
import Plutarch (Script)
6-
import PlutusLedgerApi.V2 (CurrencySymbol, ScriptContext)
7-
import Spec.HydraAuctionOnchain.Helpers (shouldFail)
9+
import PlutusLedgerApi.V2
10+
( Address
11+
, CurrencySymbol
12+
, Datum (Datum)
13+
, OutputDatum (OutputDatum)
14+
, Redeemer (Redeemer)
15+
, ScriptContext (..)
16+
, ScriptPurpose (Spending)
17+
, TxInInfo (TxInInfo)
18+
, TxInfo (..)
19+
, TxOut (..)
20+
, TxOutRef
21+
, dataToBuiltinData
22+
, toData
23+
)
24+
import PlutusTx.AssocMap qualified as AMap (singleton)
25+
import Spec.HydraAuctionOnchain.Gen (genTxInfoTemplate)
26+
import Spec.HydraAuctionOnchain.Helpers (shouldFail, shouldSucceed)
827
import Spec.HydraAuctionOnchain.Types.AuctionTerms (AuctionTerms)
28+
import Spec.HydraAuctionOnchain.Types.Redeemers (StandingBidRedeemer (NewBidRedeemer))
29+
import Spec.HydraAuctionOnchain.Types.StandingBidState (StandingBidState)
930
import Test.Tasty (TestTree, testGroup)
1031
import Test.Tasty.QuickCheck (Property, testProperty)
1132

1233
spec :: TestTree
1334
spec =
1435
testGroup
1536
"StandingBid"
16-
[ testProperty "Fails when own input is missing" prop_ownInputMissing_fails
37+
[ testProperty "Succeeds" prop_validInput_succeeds
38+
, testProperty "Fails when own input is missing" prop_ownInputMissing_fails
1739
]
1840

41+
prop_validInput_succeeds :: Property
42+
prop_validInput_succeeds = shouldSucceed undefined
43+
1944
prop_ownInputMissing_fails :: Property
2045
prop_ownInputMissing_fails = shouldFail undefined
2146

47+
data TestContext = TestContext
48+
{ auctionCs :: CurrencySymbol
49+
, auctionTerms :: AuctionTerms
50+
, datum :: StandingBidState
51+
, txInfoTemplate :: TxInfo
52+
, standingBidInputOref :: TxOutRef
53+
, scriptAddress :: Address
54+
}
55+
56+
testNewBid :: TestContext -> Script
57+
testNewBid TestContext {..} =
58+
let
59+
standingBidInput :: TxInInfo
60+
standingBidInput =
61+
TxInInfo standingBidInputOref $
62+
TxOut
63+
{ txOutAddress = scriptAddress
64+
, txOutValue = undefined
65+
, txOutDatum = OutputDatum $ Datum $ dataToBuiltinData $ toData datum
66+
, txOutReferenceScript = Nothing
67+
}
68+
69+
newBidRedeemer :: StandingBidRedeemer
70+
newBidRedeemer = NewBidRedeemer
71+
72+
redeemer :: Redeemer
73+
redeemer = Redeemer $ dataToBuiltinData $ toData newBidRedeemer
74+
75+
scriptPurpose :: ScriptPurpose
76+
scriptPurpose = Spending standingBidInputOref
77+
78+
ctx :: ScriptContext
79+
ctx =
80+
ScriptContext
81+
{ scriptContextTxInfo =
82+
txInfoTemplate
83+
{ txInfoInputs = singleton standingBidInput
84+
, txInfoOutputs = outputs
85+
, txInfoRedeemers = AMap.singleton scriptPurpose redeemer
86+
}
87+
, scriptContextPurpose = scriptPurpose
88+
}
89+
in
90+
compile auctionCs auctionTerms datum newBidRedeemer ctx
91+
2292
compile
2393
:: CurrencySymbol
2494
-> AuctionTerms
2595
-> StandingBidState
2696
-> StandingBidRedeemer
2797
-> ScriptContext
2898
-> Script
29-
compile auctionCs auctionTerms datum redeemer =
99+
compile auctionCs auctionTerms datum redeemer ctx =
30100
compileScript $
31101
popaque $
32102
standingBidValidator
33103
# pconstant auctionCs
34104
# pconstant auctionTerms
35105
# pconstant datum
36106
# pconstant redeemer
107+
# pconstant ctx

0 commit comments

Comments
 (0)