Merge pull request #7 from mlabs-haskell/dshuiski/auction-mp

Implement auction minting policy

Author: errfrom

app/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 import HydraAuctionOnchain.Scripts
   ( auctionEscrowValidatorUntyped
   , auctionMetadataValidatorUntyped
+  , auctionMintingPolicyUntyped
   , standingBidValidatorUntyped
   , writeScript
   )
@@ -23,16 +24,26 @@ main :: IO ()
 main =
   execParser (info (helper <*> scriptToCompile) fullDesc) >>= \case
     AllScripts -> do
+      writeAuctionMintingPolicy
       writeAuctionEscrowValidator
       writeStandingBidValidator
       writeAuctionMetadataValidator
+    AuctionMintingPolicy ->
+      writeAuctionMintingPolicy
     AuctionEscrowValidator ->
       writeAuctionEscrowValidator
     StandingBidValidator ->
       writeStandingBidValidator
     AuctionMetadataValidator ->
       writeAuctionMetadataValidator
 
+writeAuctionMintingPolicy :: IO ()
+writeAuctionMintingPolicy =
+  writeScript
+    "Auction minting policy"
+    "compiled/auction_minting_policy.plutus"
+    auctionMintingPolicyUntyped
+
 writeAuctionEscrowValidator :: IO ()
 writeAuctionEscrowValidator =
   writeScript
@@ -56,6 +67,7 @@ writeAuctionMetadataValidator =
 
 data ScriptToCompile
   = AllScripts
+  | AuctionMintingPolicy
   | AuctionEscrowValidator
   | StandingBidValidator
   | AuctionMetadataValidator
@@ -64,6 +76,7 @@ data ScriptToCompile
 toScript :: String -> Maybe ScriptToCompile
 toScript = \case
   "all" -> Just AllScripts
+  "auction_mp" -> Just AuctionMintingPolicy
   "auction_escrow" -> Just AuctionEscrowValidator
   "standing_bid" -> Just StandingBidValidator
   "metadata" -> Just AuctionMetadataValidator

compiled/auction_escrow_validator.plutus

@@ -102,12 +102,17 @@ common common-lang
 library
   import:          common-lang
   exposed-modules:
-    HydraAuctionOnchain.Errors.AuctionEscrow
-    HydraAuctionOnchain.Errors.StandingBid
+    HydraAuctionOnchain.Errors.MintingPolicies.Auction
+    HydraAuctionOnchain.Errors.Types.AuctionTerms
+    HydraAuctionOnchain.Errors.Validators.AuctionEscrow
+    HydraAuctionOnchain.Errors.Validators.StandingBid
     HydraAuctionOnchain.Helpers
     HydraAuctionOnchain.Lib.Address
     HydraAuctionOnchain.Lib.Cose
+    HydraAuctionOnchain.Lib.ScriptContext
     HydraAuctionOnchain.Lib.Serialization
+    HydraAuctionOnchain.Lib.Value
+    HydraAuctionOnchain.MintingPolicies.Auction
     HydraAuctionOnchain.Scripts
     HydraAuctionOnchain.Types.AuctionEscrowState
     HydraAuctionOnchain.Types.AuctionInfo

compiled/auction_metadata_validator.plutus

@@ -0,0 +1,30 @@
+module HydraAuctionOnchain.Errors.MintingPolicies.Auction
+  ( PAuctionMpError (..)
+  ) where
+
+import Data.Universe (Universe (universe), universeGeneric)
+import HydraAuctionOnchain.Types.Error (ErrorCodePrefix (errorCodePrefix))
+
+data PAuctionMpError (s :: S)
+  = -- Common errors
+    AuctionMp'Error'MissingOwnCurrencySymbol
+  | -- MintAuction errors
+    AuctionMp'MintAuction'Error'AuctionTokenBundleNotMinted
+  | AuctionMp'MintAuction'Error'MissingUtxoNonceInput
+  | AuctionMp'MintAuction'Error'MissingAuctionMetadataOutput
+  | AuctionMp'MintAuction'Error'AuctionMetadataOutputMissingToken
+  | AuctionMp'MintAuction'Error'FailedToDecodeAuctionInfo
+  | AuctionMp'MintAuction'Error'AuctionInfoCurrencySymbolMismatch
+  | -- BurnAuction errors
+    AuctionMp'BurnAuction'Error'AuctionTokenBundleNotBurned
+  deriving stock (Generic, Eq)
+  deriving anyclass (PlutusType)
+
+instance DerivePlutusType PAuctionMpError where
+  type DPTStrat _ = PlutusTypeScott
+
+instance Universe (PAuctionMpError s) where
+  universe = universeGeneric
+
+instance ErrorCodePrefix (PAuctionMpError s) where
+  errorCodePrefix = "AUMP"

compiled/auction_minting_policy.plutus

@@ -0,0 +1,30 @@
+module HydraAuctionOnchain.Errors.Types.AuctionTerms
+  ( PAuctionTermsError (..)
+  ) where
+
+import Data.Universe (Universe (universe), universeGeneric)
+import HydraAuctionOnchain.Types.Error (ErrorCodePrefix (errorCodePrefix))
+
+data PAuctionTermsError (s :: S)
+  = AuctionTerms'Error'AuctionLotNonZeroAda
+  | AuctionTerms'Error'NonPositiveAuctionLotValue
+  | AuctionTerms'Error'SellerAddressLacksPubKeyCredential
+  | AuctionTerms'Error'SellerVkPkhMismatch
+  | AuctionTerms'Error'BiddingStartNotBeforeBiddingEnd
+  | AuctionTerms'Error'BiddingEndNotBeforePurchaseDeadline
+  | AuctionTerms'Error'PurchaseDeadlineNotBeforeCleanup
+  | AuctionTerms'Error'NonPositiveMinBidIncrement
+  | AuctionTerms'Error'InvalidStartingBid
+  | AuctionTerms'Error'InvalidAuctionFeePerDelegate
+  | AuctionTerms'Error'NoDelegates
+  deriving stock (Generic, Eq)
+  deriving anyclass (PlutusType)
+
+instance DerivePlutusType PAuctionTermsError where
+  type DPTStrat _ = PlutusTypeScott
+
+instance Universe (PAuctionTermsError s) where
+  universe = universeGeneric
+
+instance ErrorCodePrefix (PAuctionTermsError s) where
+  errorCodePrefix = "AUTE"

compiled/standing_bid_validator.plutus

@@ -1,4 +1,4 @@
-module HydraAuctionOnchain.Errors.AuctionEscrow
+module HydraAuctionOnchain.Errors.Validators.AuctionEscrow
   ( PAuctionEscrowError (..)
   ) where
 

hydra-auction-onchain.cabal

@@ -1,4 +1,4 @@
-module HydraAuctionOnchain.Errors.StandingBid
+module HydraAuctionOnchain.Errors.Validators.StandingBid
   ( PStandingBidError (..)
   ) where