feat(bidder_deposit)!: implement ClaimDepositSeller sub-validator

Author: errfrom

compiled/bidder_deposit_validator.plutus

@@ -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
+  | 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

src/HydraAuctionOnchain/Errors/Validators/BidderDeposit.hs

@@ -6,6 +6,7 @@ module HydraAuctionOnchain.Types.AuctionTerms
   , pcleanupPeriod
   , ppenaltyPeriod
   , ppostBiddingPeriod
+  , ppostPurchasePeriod
   , ppurchasePeriod
   , ptotalAuctionFees
   , pvalidateAuctionTerms
@@ -168,3 +169,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

src/HydraAuctionOnchain/Types/AuctionTerms.hs

@@ -255,7 +255,7 @@ pcheckStartBidding = phoistAcyclic $
     pcon PUnit
 
 ----------------------------------------------------------------------
--- StartBidding
+-- BidderBuys
 
 pcheckBidderBuys
   :: Term

src/HydraAuctionOnchain/Validators/AuctionEscrow.hs

@@ -3,6 +3,7 @@
 module HydraAuctionOnchain.Validators.BidderDeposit
   ( PBidderDepositRedeemer
       ( UseDepositWinnerRedeemer
+      , ClaimDepositSellerRedeemer
       , ReclaimDepositLoserRedeemer
       , ReclaimDepositAuctionConcludedRedeemer
       , ReclaimDepositCleanupRedeemer
@@ -26,6 +27,7 @@ import HydraAuctionOnchain.Types.AuctionTerms
   ( PAuctionTerms
   , pcleanupPeriod
   , ppostBiddingPeriod
+  , ppostPurchasePeriod
   )
 import HydraAuctionOnchain.Types.BidderInfo (PBidderInfo)
 import HydraAuctionOnchain.Types.Error (errCode, passert, passertMaybe)
@@ -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)
@@ -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 '[]))
@@ -103,6 +106,14 @@ bidderDepositValidator = phoistAcyclic $
           # auctionEscrowSh
           # auctionCs
           # bidderInfo
+      ClaimDepositSellerRedeemer _ ->
+        pcheckClaimDepositSeller
+          # txInfo
+          # standingBidSh
+          # auctionEscrowSh
+          # auctionCs
+          # auctionTerms
+          # bidderInfo
       ReclaimDepositLoserRedeemer _ ->
         pcheckReclaimDepositLoser
           # txInfo
@@ -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
 --