Skip to content

Commit b01d7a8

Browse files
errfromerrfrom
authored
Merge pull request #8 from mlabs-haskell/dshuiski/bidder-deposit-validator
Implement bidder deposit validator
2 parents a7cecbe + 79d97bd commit b01d7a8

20 files changed

+713
-122
lines changed

‎Makefile‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
.PHONY: build test repl format hoogle all_scripts auction_escrow_validator standing_bid_validator auction_metadata_validator
1+
.PHONY: build test repl format hoogle all_scripts auction_escrow_validator standing_bid_validator bidder_deposit_validator auction_metadata_validator
22

33
hs-sources := $(shell fd --no-ignore-parent -ehs)
44
cabal-sources := $(shell fd --no-ignore-parent -ecabal)
@@ -27,5 +27,8 @@ auction_escrow_validator:
2727
standing_bid_validator:
2828
cabal v2-run hydra-auction-onchain-exe -- --script standing_bid
2929

30+
bidder_deposit_validator:
31+
cabal v2-run hydra-auction-onchain-exe -- --script bidder_deposit
32+
3033
auction_metadata_validator:
3134
cabal v2-run hydra-auction-onchain-exe -- --script metadata

‎app/Main.hs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ import HydraAuctionOnchain.Scripts
44
( auctionEscrowValidatorUntyped
55
, auctionMetadataValidatorUntyped
66
, auctionMintingPolicyUntyped
7+
, bidderDepositValidatorUntyped
78
, standingBidValidatorUntyped
89
, writeScript
910
)
@@ -27,13 +28,16 @@ main =
2728
writeAuctionMintingPolicy
2829
writeAuctionEscrowValidator
2930
writeStandingBidValidator
31+
writeBidderDepositValidator
3032
writeAuctionMetadataValidator
3133
AuctionMintingPolicy ->
3234
writeAuctionMintingPolicy
3335
AuctionEscrowValidator ->
3436
writeAuctionEscrowValidator
3537
StandingBidValidator ->
3638
writeStandingBidValidator
39+
BidderDepositValidator ->
40+
writeBidderDepositValidator
3741
AuctionMetadataValidator ->
3842
writeAuctionMetadataValidator
3943

@@ -58,6 +62,13 @@ writeStandingBidValidator =
5862
"compiled/standing_bid_validator.plutus"
5963
standingBidValidatorUntyped
6064

65+
writeBidderDepositValidator :: IO ()
66+
writeBidderDepositValidator =
67+
writeScript
68+
"Bidder deposit validator"
69+
"compiled/bidder_deposit_validator.plutus"
70+
bidderDepositValidatorUntyped
71+
6172
writeAuctionMetadataValidator :: IO ()
6273
writeAuctionMetadataValidator =
6374
writeScript
@@ -70,6 +81,7 @@ data ScriptToCompile
7081
| AuctionMintingPolicy
7182
| AuctionEscrowValidator
7283
| StandingBidValidator
84+
| BidderDepositValidator
7385
| AuctionMetadataValidator
7486
deriving stock (Show, Eq)
7587

@@ -79,6 +91,7 @@ toScript = \case
7991
"auction_mp" -> Just AuctionMintingPolicy
8092
"auction_escrow" -> Just AuctionEscrowValidator
8193
"standing_bid" -> Just StandingBidValidator
94+
"bidder_deposit" -> Just BidderDepositValidator
8295
"metadata" -> Just AuctionMetadataValidator
8396
_ -> Nothing
8497

‎compiled/auction_escrow_validator.plutus‎

Lines changed: 4 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎compiled/auction_minting_policy.plutus‎

Lines changed: 2 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎compiled/bidder_deposit_validator.plutus‎

Lines changed: 13 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎compiled/standing_bid_validator.plutus‎

Lines changed: 2 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎hydra-auction-onchain.cabal‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@ library
105105
HydraAuctionOnchain.Errors.MintingPolicies.Auction
106106
HydraAuctionOnchain.Errors.Types.AuctionTerms
107107
HydraAuctionOnchain.Errors.Validators.AuctionEscrow
108+
HydraAuctionOnchain.Errors.Validators.BidderDeposit
108109
HydraAuctionOnchain.Errors.Validators.StandingBid
109110
HydraAuctionOnchain.Helpers
110111
HydraAuctionOnchain.Lib.Address
@@ -120,10 +121,12 @@ library
120121
HydraAuctionOnchain.Types.BidderInfo
121122
HydraAuctionOnchain.Types.BidTerms
122123
HydraAuctionOnchain.Types.Error
124+
HydraAuctionOnchain.Types.Scripts
123125
HydraAuctionOnchain.Types.StandingBidState
124126
HydraAuctionOnchain.Types.Tokens
125127
HydraAuctionOnchain.Validators.AuctionEscrow
126128
HydraAuctionOnchain.Validators.AuctionMetadata
129+
HydraAuctionOnchain.Validators.BidderDeposit
127130
HydraAuctionOnchain.Validators.StandingBid
128131

129132
build-depends:

‎src/HydraAuctionOnchain/Errors/Validators/BidderDeposit.hs‎

Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
module HydraAuctionOnchain.Errors.Validators.BidderDeposit
2+
( PBidderDepositError (..)
3+
) where
4+
5+
import Data.Universe (Universe (universe), universeGeneric)
6+
import HydraAuctionOnchain.Types.Error (ErrorCodePrefix (errorCodePrefix))
7+
8+
data PBidderDepositError (s :: S)
9+
= -- Common errors
10+
BidderDeposit'Error'MissingOwnInput
11+
| BidderDeposit'Error'TooManyOwnScriptInputs
12+
| BidderDeposit'Error'UnexpectedTokensMintedBurned
13+
| -- UseDepositWinner errors
14+
BidderDeposit'UseDepositWinner'Error'MissingStandingBidInput
15+
| BidderDeposit'UseDepositWinner'Error'StandingBidInputMissingToken
16+
| BidderDeposit'UseDepositWinner'Error'FailedToDecodeStandingBidState
17+
| BidderDeposit'UseDepositWinner'Error'BidderNotWinner
18+
| BidderDeposit'UseDepositWinner'Error'MissingAuctionEscrowInput
19+
| BidderDeposit'UseDepositWinner'Error'AuctionEscrowInputMissingToken
20+
| BidderDeposit'UseDepositWinner'Error'InvalidAuctionEscrowRedeemer
21+
| -- ReclaimDepositLoser errors
22+
BidderDeposit'ReclaimDepositLoser'Error'MissingStandingBidInput
23+
| BidderDeposit'ReclaimDepositLoser'Error'StandingBidInputMissingToken
24+
| BidderDeposit'ReclaimDepositLoser'Error'FailedToDecodeStandingBidState
25+
| BidderDeposit'ReclaimDepositLoser'Error'BidderNotLoser
26+
| BidderDeposit'ReclaimDepositLoser'Error'IncorrectValidityInterval
27+
| BidderDeposit'ReclaimDepositLoser'Error'InvalidBidderAddress
28+
| BidderDeposit'ReclaimDepositLoser'Error'NoBidderConsent
29+
| -- ReclaimDepositAuctionConcluded errors
30+
BidderDeposit'ReclaimDepositConcluded'Error'MissingAuctionRefInput
31+
| BidderDeposit'ReclaimDepositConcluded'Error'AuctionRefInputMissingToken
32+
| BidderDeposit'ReclaimDepositConcluded'Error'FailedToDecodeAuctionState
33+
| BidderDeposit'ReclaimDepositConcluded'Error'AuctionNotConcluded
34+
| BidderDeposit'ReclaimDepositConcluded'Error'IncorrectValidityInterval
35+
| BidderDeposit'ReclaimDepositConcluded'Error'InvalidBidderAddress
36+
| BidderDeposit'ReclaimDepositConcluded'Error'NoBidderConsent
37+
| -- ReclaimDepositCleanup errors
38+
BidderDeposit'ReclaimDepositCleanup'Error'IncorrectValidityInterval
39+
| BidderDeposit'ReclaimDepositCleanup'Error'InvalidBidderAddress
40+
| BidderDeposit'ReclaimDepositCleanup'Error'NoBidderConsent
41+
deriving stock (Generic, Eq)
42+
deriving anyclass (PlutusType)
43+
44+
instance DerivePlutusType PBidderDepositError where
45+
type DPTStrat _ = PlutusTypeScott
46+
47+
instance Universe (PBidderDepositError s) where
48+
universe = universeGeneric
49+
50+
instance ErrorCodePrefix (PBidderDepositError s) where
51+
errorCodePrefix = "BIDE"

‎src/HydraAuctionOnchain/Helpers.hs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module HydraAuctionOnchain.Helpers
99
, pfindUniqueInputWithToken
1010
, pfindUniqueOutputWithAddress
1111
, pfindUniqueOutputWithScriptHash
12+
, pfindUniqueRefInputWithScriptHash
1213
, pgetOwnInput
1314
, pintervalFiniteClosedOpen
1415
, ponlyOneInputFromAddress
@@ -88,6 +89,18 @@ pfindUniqueInputWithScriptHash = phoistAcyclic $
8889
#$ pfield @"inputs"
8990
# txInfo
9091

92+
pfindUniqueRefInputWithScriptHash :: Term s (PScriptHash :--> PTxInfo :--> PMaybe PTxInInfo)
93+
pfindUniqueRefInputWithScriptHash = phoistAcyclic $
94+
plam $ \sh txInfo ->
95+
pfindUnique
96+
# plam
97+
( \utxo -> P.do
98+
addr <- plet $ pfield @"address" #$ pfield @"resolved" # utxo
99+
paddressHasScriptHash # addr # sh
100+
)
101+
#$ pfield @"referenceInputs"
102+
# txInfo
103+
91104
pfindUniqueInputWithToken
92105
:: Term
93106
s

‎src/HydraAuctionOnchain/Lib/ScriptContext.hs‎

Lines changed: 34 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,40 @@
11
module HydraAuctionOnchain.Lib.ScriptContext
2-
( pownCurrencySymbol
2+
( pinputSpentWithRedeemer
3+
, pownCurrencySymbol
34
) where
45

5-
import Plutarch.Api.V2 (PCurrencySymbol, PScriptContext, PScriptPurpose (PMinting))
6-
import Plutarch.Extra.Maybe (pjust, pnothing)
6+
import Plutarch.Api.V2
7+
( PCurrencySymbol
8+
, PScriptContext
9+
, PScriptPurpose (PMinting, PSpending)
10+
, PTxInInfo
11+
, PTxInfo
12+
)
13+
import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing)
14+
import Plutarch.Extra.ScriptContext (ptryFromRedeemer)
15+
import Plutarch.Monadic qualified as P
16+
17+
pinputSpentWithRedeemer
18+
:: ( PIsData red
19+
, PTryFrom PData (PAsData red)
20+
)
21+
=> Term
22+
s
23+
( (red :--> PBool)
24+
:--> PTxInfo
25+
:--> PTxInInfo
26+
:--> PBool
27+
)
28+
pinputSpentWithRedeemer = phoistAcyclic $
29+
plam $ \p txInfo input -> P.do
30+
redeemers <- plet $ pfield @"redeemers" # txInfo
31+
oref <- plet $ pfield @"outRef" # input
32+
purpose <- plet $ pcon $ PSpending $ pdcons @"_0" # oref # pdnil
33+
redeemer <- plet $ ptryFromRedeemer # purpose # redeemers
34+
pmaybe
35+
# pcon PFalse
36+
# plam (\redeemer -> p # pfromData redeemer)
37+
# redeemer
738

839
pownCurrencySymbol :: Term s (PScriptContext :--> PMaybe PCurrencySymbol)
940
pownCurrencySymbol = phoistAcyclic $

0 commit comments

Comments
 (0)