feat(auction_escrow): implement CleanupAuction sub-validator

Author: errfrom

src/HydraAuctionOnchain/Errors/AuctionEscrow.hs

@@ -49,6 +49,12 @@ data PAuctionEscrowError (s :: S)
   | AuctionEscrow'SellerReclaims'Error'PaymentToSellerIncorrect
   | AuctionEscrow'SellerReclaims'Error'NoSellerConsent
   | AuctionEscrow'SellerReclaims'Error'PaymentToFeeEscrowIncorrect
+  | -- CleanupAuction errors
+    AuctionEscrow'CleanupAuction'Error'AuctionTokensNotBurnedExactly
+  | AuctionEscrow'CleanupAuction'Error'IncorrectValidityInterval
+  | AuctionEscrow'CleanupAuction'Error'NoSellerConsent
+  | AuctionEscrow'CleanupAuction'Error'AuctionIsNotConcluded
+  | AuctionEscrow'CleanupAuction'Error'AuctionEscrowInputMissingStandingBidToken
   deriving stock (Generic, Eq)
   deriving anyclass (PlutusType)
 

src/HydraAuctionOnchain/MintingPolicies/Auction.hs

@@ -1,10 +1,19 @@
 module HydraAuctionOnchain.MintingPolicies.Auction
-  ( auctionEscrowTokenName
+  ( allAuctionTokensBurned
+  , auctionEscrowTokenName
   , auctionMetadataTokenName
   , standingBidTokenName
   ) where
 
-import Plutarch.Api.V2 (PTokenName)
+import Plutarch.Api.V1.Value qualified as Value (psingleton)
+import Plutarch.Api.V2
+  ( AmountGuarantees (NonZero)
+  , KeyGuarantees (Sorted)
+  , PCurrencySymbol
+  , PTokenName
+  , PValue
+  )
+import Plutarch.Monadic qualified as P
 
 -- | Auction state token, identifying the true auction escrow.
 auctionEscrowTokenName :: Term s PTokenName
@@ -17,3 +26,11 @@ auctionMetadataTokenName = pconstant "AUCTION_METADATA"
 -- | Standing bid token, identifying the true standing bid.
 standingBidTokenName :: Term s PTokenName
 standingBidTokenName = pconstant "STANDING_BID"
+
+allAuctionTokensBurned :: Term s (PCurrencySymbol :--> PValue 'Sorted 'NonZero)
+allAuctionTokensBurned = phoistAcyclic $
+  plam $ \auctionCs -> P.do
+    mkValue <- plet $ plam $ \tn -> Value.psingleton # auctionCs # tn # (-1)
+    (mkValue # auctionEscrowTokenName)
+      <> (mkValue # auctionMetadataTokenName)
+      <> (mkValue # standingBidTokenName)

src/HydraAuctionOnchain/Types/AuctionTerms.hs

@@ -1,6 +1,7 @@
 module HydraAuctionOnchain.Types.AuctionTerms
   ( PAuctionTerms (PAuctionTerms)
   , pbiddingPeriod
+  , pcleanupPeriod
   , ppenaltyPeriod
   , ppurchasePeriod
   , ptotalAuctionFees
@@ -16,6 +17,7 @@ import Plutarch.Api.V2
   , PValue
   )
 import Plutarch.DataRepr (PDataFields)
+import Plutarch.Extra.Interval qualified as Interval (pfrom)
 import Plutarch.Monadic qualified as P
 import Ply.Plutarch (PlyArgOf)
 
@@ -83,3 +85,8 @@ ppenaltyPeriod = phoistAcyclic $
     pintervalFiniteClosedOpen
       # auctionTermsFields.purchaseDeadline
       # auctionTermsFields.cleanup
+
+pcleanupPeriod :: Term s (PAuctionTerms :--> PPOSIXTimeRange)
+pcleanupPeriod = phoistAcyclic $
+  plam $ \auctionTerms ->
+    Interval.pfrom #$ pfield @"cleanup" # auctionTerms

src/HydraAuctionOnchain/Validators/AuctionEscrow.hs

@@ -25,23 +25,32 @@ import HydraAuctionOnchain.Helpers
   , pvaluePaidTo
   , pvaluePaidToScript
   )
+import HydraAuctionOnchain.MintingPolicies.Auction (allAuctionTokensBurned)
 import HydraAuctionOnchain.Types.AuctionEscrowState
-  ( PAuctionEscrowState
+  ( PAuctionEscrowState (AuctionConcluded)
   , pvalidateAuctionEscrowTransitionToAuctionConcluded
   , pvalidateAuctionEscrowTransitionToBiddingStarted
   )
 import HydraAuctionOnchain.Types.AuctionTerms
   ( PAuctionTerms
   , pbiddingPeriod
+  , pcleanupPeriod
   , ppenaltyPeriod
   , ppurchasePeriod
   , ptotalAuctionFees
   )
 import HydraAuctionOnchain.Types.BidTerms (psellerPayout, pvalidateBidTerms)
 import HydraAuctionOnchain.Types.Error (errCode, passert, passertMaybe, passertMaybeData)
 import HydraAuctionOnchain.Types.StandingBidState (PStandingBidState (PStandingBidState))
-import Plutarch.Api.V1.Value (plovelaceValueOf)
-import Plutarch.Api.V2 (PAddress, PCurrencySymbol, PScriptContext, PScriptHash, PTxInfo)
+import Plutarch.Api.V1.Value (plovelaceValueOf, pnormalize)
+import Plutarch.Api.V2
+  ( PAddress
+  , PCurrencySymbol
+  , PScriptContext
+  , PScriptHash
+  , PTxInInfo
+  , PTxInfo
+  )
 import Plutarch.Extra.Interval (pcontains)
 import Plutarch.Extra.Maybe (pdnothing)
 import Plutarch.Extra.ScriptContext (ptxSignedBy)
@@ -136,7 +145,12 @@ auctionEscrowValidator = phoistAcyclic $
           # oldAuctionState
           # ownAddress
       CleanupAuctionRedeemer _ ->
-        undefined
+        pcheckCleanupAuction
+          # txInfo
+          # auctionCs
+          # auctionTerms
+          # oldAuctionState
+          # ownInput
 
 --------------------------------------------------------------------------------
 -- StartBidding
@@ -456,3 +470,47 @@ pcheckSellerReclaims = phoistAcyclic $
         #<= (plovelaceValueOf #$ pvaluePaidToScript # txInfo # feeEscrowSh)
 
     pcon PUnit
+
+--------------------------------------------------------------------------------
+-- CleanupAuction
+--------------------------------------------------------------------------------
+
+pcheckCleanupAuction
+  :: Term
+      s
+      ( PTxInfo
+          :--> PCurrencySymbol
+          :--> PAuctionTerms
+          :--> PAuctionEscrowState
+          :--> PTxInInfo
+          :--> PUnit
+      )
+pcheckCleanupAuction = phoistAcyclic $
+  plam $ \txInfo auctionCs auctionTerms auctionState ownInput -> P.do
+    txInfoFields <- pletFields @["mint", "signatories", "validRange"] txInfo
+
+    -- (AUES39) The auction state, auction metadata,and standing bid
+    -- tokens of the auction should all be burned. No other tokens
+    -- should be minted or burned.
+    passert $(errCode AuctionEscrow'CleanupAuction'Error'AuctionTokensNotBurnedExactly) $
+      pnormalize # txInfoFields.mint #== allAuctionTokensBurned # auctionCs
+
+    -- (AUES40) This redeemer can only be used during the cleanup period.
+    passert $(errCode AuctionEscrow'CleanupAuction'Error'IncorrectValidityInterval) $
+      pcontains # (pcleanupPeriod # auctionTerms) # txInfoFields.validRange
+
+    -- (AUES41) The seller signed the transaction.
+    sellerPkh <- plet $ pfield @"sellerPkh" # auctionTerms
+    passert $(errCode AuctionEscrow'CleanupAuction'Error'NoSellerConsent) $
+      ptxSignedBy # txInfoFields.signatories # pdata sellerPkh
+
+    -- (AUES42) The auction is concluded.
+    passert $(errCode AuctionEscrow'CleanupAuction'Error'AuctionIsNotConcluded) $
+      auctionState #== pcon (AuctionConcluded pdnil)
+
+    -- (AUES43) The auction escrow input contains the standing bid
+    -- token in addition to the auction token.
+    passert $(errCode AuctionEscrow'CleanupAuction'Error'AuctionEscrowInputMissingStandingBidToken) $
+      ptxOutContainsStandingBidToken # auctionCs #$ pfield @"resolved" # ownInput
+
+    pcon PUnit