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.

Sign up for GitHub

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

Jump to bottom

BidderDeposit: Implement ClaimDepositSeller sub-validator #11

Open
wants to merge 2 commits into
base: staging
Choose a base branch
from
Open

BidderDeposit: Implement ClaimDepositSeller sub-validator #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
36be989
feat(bidder_deposit)!: implement `ClaimDepositSeller` sub-validator
errfrom Feb 19, 2024
11ce32b
feat(auction_escrow): allow auction lot reclaim after cleanup time
errfrom Feb 21, 2024
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
4 changes: 2 additions & 2 deletions compiled/auction_escrow_validator.plutus
View file
Open in desktop

Large diffs are not rendered by default.

4 changes: 2 additions & 2 deletions compiled/bidder_deposit_validator.plutus
View file
Open in desktop

Large diffs are not rendered by default.

9 changes: 9 additions & 0 deletions src/HydraAuctionOnchain/Errors/Validators/BidderDeposit.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,15 @@ data PBidderDepositError (s :: S)
| BidderDeposit'UseDepositWinner'Error'MissingAuctionEscrowInput
| BidderDeposit'UseDepositWinner'Error'AuctionEscrowInputMissingToken
| BidderDeposit'UseDepositWinner'Error'InvalidAuctionEscrowRedeemer
| -- ClaimDepositSeller errors
BidderDeposit'ClaimDepositSeller'Error'IncorrectValidityInterval
| BidderDeposit'ClaimDepositSeller'Error'MissingStandingBidInput
| BidderDeposit'ClaimDepositSeller'Error'StandingBidInputMissingToken
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we be more specific in terms of which token we mean?

| BidderDeposit'ClaimDepositSeller'Error'FailedToDecodeStandingBidState
| BidderDeposit'ClaimDepositSeller'Error'BidderNotWinner
| BidderDeposit'ClaimDepositSeller'Error'MissingAuctionEscrowInput
| BidderDeposit'ClaimDepositSeller'Error'AuctionEscrowInputMissingToken
| BidderDeposit'ClaimDepositSeller'Error'InvalidAuctionEscrowRedeemer
| -- ReclaimDepositLoser errors
BidderDeposit'ReclaimDepositLoser'Error'MissingStandingBidInput
| BidderDeposit'ReclaimDepositLoser'Error'StandingBidInputMissingToken
Expand Down
15 changes: 6 additions & 9 deletions src/HydraAuctionOnchain/Types/AuctionTerms.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@ module HydraAuctionOnchain.Types.AuctionTerms
( PAuctionTerms (PAuctionTerms)
, pbiddingPeriod
, pcleanupPeriod
, ppenaltyPeriod
, ppostBiddingPeriod
, ppostPurchasePeriod
, ppurchasePeriod
, ptotalAuctionFees
, pvalidateAuctionTerms
Expand Down Expand Up @@ -151,14 +151,6 @@ ppurchasePeriod = phoistAcyclic $
# auctionTermsFields.biddingEnd
# auctionTermsFields.purchaseDeadline

ppenaltyPeriod :: Term s (PAuctionTerms :--> PPOSIXTimeRange)
ppenaltyPeriod = phoistAcyclic $
plam $ \auctionTerms -> P.do
auctionTermsFields <- pletFields @["purchaseDeadline", "cleanup"] auctionTerms
pintervalFiniteClosedOpen
# auctionTermsFields.purchaseDeadline
# auctionTermsFields.cleanup

pcleanupPeriod :: Term s (PAuctionTerms :--> PPOSIXTimeRange)
pcleanupPeriod = phoistAcyclic $
plam $ \auctionTerms ->
Expand All @@ -168,3 +160,8 @@ ppostBiddingPeriod :: Term s (PAuctionTerms :--> PPOSIXTimeRange)
ppostBiddingPeriod = phoistAcyclic $
plam $ \auctionTerms ->
Interval.pfrom #$ pfield @"biddingEnd" # auctionTerms

ppostPurchasePeriod :: Term s (PAuctionTerms :--> PPOSIXTimeRange)
ppostPurchasePeriod = phoistAcyclic $
plam $ \auctionTerms ->
Interval.pfrom #$ pfield @"purchaseDeadline" # auctionTerms
9 changes: 4 additions & 5 deletions src/HydraAuctionOnchain/Validators/AuctionEscrow.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ import HydraAuctionOnchain.Types.AuctionTerms
( PAuctionTerms
, pbiddingPeriod
, pcleanupPeriod
, ppenaltyPeriod
, ppostPurchasePeriod
, ppurchasePeriod
, ptotalAuctionFees
)
Expand Down Expand Up @@ -255,7 +255,7 @@ pcheckStartBidding = phoistAcyclic $
pcon PUnit

----------------------------------------------------------------------
-- StartBidding
-- BidderBuys

pcheckBidderBuys
:: Term
Expand Down Expand Up @@ -416,10 +416,9 @@ pcheckSellerReclaims = phoistAcyclic $
passert $(errCode AuctionEscrow'SellerReclaims'Error'UnexpectedTokensMintedBurned) $
pfromData txInfoFields.mint #== mempty

-- This redeemer can only be used during
-- the penalty period.
-- This redeemer can only be used after the purchase deadline.
passert $(errCode AuctionEscrow'SellerReclaims'Error'IncorrectValidityInterval) $
pcontains # (ppenaltyPeriod # auctionTerms) # txInfoFields.validRange
pcontains # (ppostPurchasePeriod # auctionTerms) # txInfoFields.validRange

------------------------------------------------------------------
-- Check auction escrow state transition
Expand Down
85 changes: 84 additions & 1 deletion src/HydraAuctionOnchain/Validators/BidderDeposit.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
module HydraAuctionOnchain.Validators.BidderDeposit
( PBidderDepositRedeemer
( UseDepositWinnerRedeemer
, ClaimDepositSellerRedeemer
, ReclaimDepositLoserRedeemer
, ReclaimDepositAuctionConcludedRedeemer
, ReclaimDepositCleanupRedeemer
Expand All @@ -26,6 +27,7 @@ import HydraAuctionOnchain.Types.AuctionTerms
( PAuctionTerms
, pcleanupPeriod
, ppostBiddingPeriod
, ppostPurchasePeriod
)
import HydraAuctionOnchain.Types.BidderInfo (PBidderInfo)
import HydraAuctionOnchain.Types.Error (errCode, passert, passertMaybe)
Expand All @@ -36,7 +38,7 @@ import HydraAuctionOnchain.Types.Tokens
, ptxOutContainsStandingBidToken
)
import HydraAuctionOnchain.Validators.AuctionEscrow
( PAuctionEscrowRedeemer (BidderBuysRedeemer)
( PAuctionEscrowRedeemer (BidderBuysRedeemer, SellerReclaimsRedeemer)
)
import Plutarch.Api.V2 (PCurrencySymbol, PScriptContext, PTxInfo)
import Plutarch.Extra.Interval (pcontains)
Expand All @@ -48,6 +50,7 @@ import Plutarch.Monadic qualified as P

data PBidderDepositRedeemer (s :: S)
= UseDepositWinnerRedeemer (Term s (PDataRecord '[]))
| ClaimDepositSellerRedeemer (Term s (PDataRecord '[]))
| ReclaimDepositLoserRedeemer (Term s (PDataRecord '[]))
| ReclaimDepositAuctionConcludedRedeemer (Term s (PDataRecord '[]))
| ReclaimDepositCleanupRedeemer (Term s (PDataRecord '[]))
Expand Down Expand Up @@ -103,6 +106,14 @@ bidderDepositValidator = phoistAcyclic $
# auctionEscrowSh
# auctionCs
# bidderInfo
ClaimDepositSellerRedeemer _ ->
pcheckClaimDepositSeller
# txInfo
# standingBidSh
# auctionEscrowSh
# auctionCs
# auctionTerms
# bidderInfo
ReclaimDepositLoserRedeemer _ ->
pcheckReclaimDepositLoser
# txInfo
Expand Down Expand Up @@ -189,6 +200,78 @@ pcheckUseDepositWinner = phoistAcyclic $

pcon PUnit

----------------------------------------------------------------------
-- ClaimDepositSeller
--
-- The bidder deposit is claimed by the seller if the auction lot has
-- not been purchased before the purchase deadline.

pcheckClaimDepositSeller
:: Term
s
( PTxInfo
:--> PStandingBidScriptHash
:--> PAuctionEscrowScriptHash
:--> PCurrencySymbol
:--> PAuctionTerms
:--> PBidderInfo
:--> PUnit
)
pcheckClaimDepositSeller = phoistAcyclic $
plam $ \txInfo standingBidSh auctionEscrowSh auctionCs auctionTerms bidderInfo -> P.do
-- This redeemer can only be used after the purchase deadline.
validRange <- plet $ pfield @"validRange" # txInfo
passert $(errCode BidderDeposit'ClaimDepositSeller'Error'IncorrectValidityInterval) $
pcontains # (ppostPurchasePeriod # auctionTerms) # validRange

-- There should be exactly one standing bid input.
standingBidInput <-
plet $
passertMaybe
$(errCode BidderDeposit'ClaimDepositSeller'Error'MissingStandingBidInput)
(pfindUniqueInputWithScriptHash # pto standingBidSh # txInfo)

-- The standing bid input should contain the standing
-- bid token.
standingBidInputResolved <- plet $ pfield @"resolved" # standingBidInput
passert $(errCode BidderDeposit'ClaimDepositSeller'Error'StandingBidInputMissingToken) $
ptxOutContainsStandingBidToken # auctionCs # standingBidInputResolved

-- The standing bid input contains a datum that can be decoded
-- as a standing bid state.
bidState <-
plet $
passertMaybe
$(errCode BidderDeposit'ClaimDepositSeller'Error'FailedToDecodeStandingBidState)
(pdecodeInlineDatum # standingBidInputResolved)

-- The bidder deposit's bidder won the auction.
passert $(errCode BidderDeposit'ClaimDepositSeller'Error'BidderNotWinner) $
pbidderWon # bidState # bidderInfo

-- There should be exactly one auction escrow input.
auctionEscrowInput <-
plet $
passertMaybe
$(errCode BidderDeposit'ClaimDepositSeller'Error'MissingAuctionEscrowInput)
(pfindUniqueInputWithScriptHash # pto auctionEscrowSh # txInfo)

-- The auction escrow input should contain the auction
-- escrow token.
auctionEscrowInputResolved <- plet $ pfield @"resolved" # auctionEscrowInput
passert $(errCode BidderDeposit'ClaimDepositSeller'Error'AuctionEscrowInputMissingToken) $
ptxOutContainsAuctionEscrowToken # auctionCs # auctionEscrowInputResolved

-- The auction escrow input is being spent with
-- the `SellerReclaims` redeemer.
passert $(errCode BidderDeposit'ClaimDepositSeller'Error'InvalidAuctionEscrowRedeemer) $
pinputSpentWithRedeemer
# plam (\redeemer -> redeemer #== pcon (SellerReclaimsRedeemer pdnil))
# txInfo
# auctionEscrowInput

pcon PUnit

----------------------------------------------------------------------
-- ReclaimDepositLoser
--
Expand Down