feat: implement auction metadata validator

Author: errfrom

.gitattributes

@@ -0,0 +1,2 @@
+flake.lock linguist-generated=true
+compiled/* linguist-generated=true

Makefile

@@ -1,4 +1,4 @@
-.PHONY: build, repl, format
+.PHONY: build, repl, format, hoogle, auction_metadata_validator
 
 hs-sources := $(shell fd --no-ignore-parent -ehs)
 cabal-sources := $(shell fd --no-ignore-parent -ecabal)
@@ -11,3 +11,9 @@ repl:
 
 format:
 	fourmolu -m inplace ${hs-sources} && cabal-fmt -i ${cabal-sources} && nix run '.#nixFormat'
+
+hoogle:
+	hoogle server --local --port=8070 > /dev/null &
+
+auction_metadata_validator:
+	cabal v2-run hydra-auction-onchain-exe

app/Main.hs

@@ -1,4 +1,10 @@
 module Main (main) where
 
+import HydraAuctionOnchain.Scripts (auctionMetadataValidatorUntyped, writeScript)
+
 main :: IO ()
-main = return ()
+main =
+  writeScript
+    "Auction metadata validator"
+    "compiled/auction_metadata_validator.plutus"
+    auctionMetadataValidatorUntyped

compiled/auction_metadata_validator.plutus

@@ -8,7 +8,7 @@ record-brace-space: true
 newlines-between-decls: 1
 haddock-style: single-line
 haddock-style-module: single-line
-let-style: newline
+let-style: mixed
 in-style: no-space
 single-constraint-parens: never
 unicode: never

fourmolu.yaml

@@ -101,7 +101,14 @@ common common-lang
 
 library
   import:          common-lang
-  exposed-modules: HydraAuctionOnchain.Helpers
+  exposed-modules:
+    HydraAuctionOnchain.Helpers
+    HydraAuctionOnchain.MintingPolicies.Auction
+    HydraAuctionOnchain.Scripts
+    HydraAuctionOnchain.Types.AuctionInfo
+    HydraAuctionOnchain.Types.AuctionTerms
+    HydraAuctionOnchain.Validators.AuctionMetadata
+
   build-depends:
     , bytestring
     , data-default

hydra-auction-onchain.cabal

@@ -0,0 +1,19 @@
+module HydraAuctionOnchain.MintingPolicies.Auction
+  ( auctionEscrowTokenName
+  , auctionMetadataTokenName
+  , standingBidTokenName
+  ) where
+
+import Plutarch.Api.V2 (PTokenName)
+
+-- | Auction state token, identifying the true auction escrow.
+auctionEscrowTokenName :: Term s PTokenName
+auctionEscrowTokenName = pconstant "AUCTION"
+
+-- | Auction metadata token, identifying the true auction metadata.
+auctionMetadataTokenName :: Term s PTokenName
+auctionMetadataTokenName = pconstant "AUCTION_METADATA"
+
+-- | Standing bid token, identifying the true standing bid.
+standingBidTokenName :: Term s PTokenName
+standingBidTokenName = pconstant "STANDING_BID"

src/HydraAuctionOnchain/MintingPolicies/Auction.hs

@@ -0,0 +1,36 @@
+module HydraAuctionOnchain.Scripts
+  ( auctionMetadataValidatorScript
+  , auctionMetadataValidatorUntyped
+  , writeScript
+  ) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unpack)
+import HydraAuctionOnchain.Validators.AuctionMetadata (auctionMetadataValidator)
+import Plutarch (Config (Config), Script, TracingMode (DoTracingAndBinds), compile)
+import Plutarch.Api.V2 (PValidator)
+import Plutarch.Unsafe (punsafeCoerce)
+import Ply.Plutarch.TypedWriter (TypedWriter, writeTypedScript)
+
+auctionMetadataValidatorUntyped :: ClosedTerm PValidator
+auctionMetadataValidatorUntyped =
+  phoistAcyclic $ plam $ \datum redeemer ctx ->
+    popaque $
+      auctionMetadataValidator
+        # punsafeCoerce datum
+        # punsafeCoerce redeemer
+        # ctx
+
+auctionMetadataValidatorScript :: Script
+auctionMetadataValidatorScript = compileScript auctionMetadataValidatorUntyped
+
+config :: Config
+config = Config DoTracingAndBinds
+
+writeScript :: TypedWriter a => Text -> FilePath -> ClosedTerm a -> IO ()
+writeScript desc term = writeTypedScript config desc term
+
+compileScript :: ClosedTerm a -> Script
+compileScript term =
+  either (error . mappend "Plutarch compilation error: " . T.unpack) id $
+    compile config term

src/HydraAuctionOnchain/Scripts.hs

@@ -0,0 +1,27 @@
+module HydraAuctionOnchain.Types.AuctionInfo
+  ( PAuctionInfo (PAuctionInfo)
+  ) where
+
+import HydraAuctionOnchain.Types.AuctionTerms (PAuctionTerms)
+import Plutarch.Api.V2 (PAddress, PCurrencySymbol)
+import Plutarch.DataRepr (PDataFields)
+
+newtype PAuctionInfo (s :: S)
+  = PAuctionInfo
+      ( Term
+          s
+          ( PDataRecord
+              '[ "auctionId" ':= PCurrencySymbol
+               , "auctionTerms" ':= PAuctionTerms
+               , "auctionEscrowAddr" ':= PAddress
+               , "bidderDepositAddr" ':= PAddress
+               , "feeEscrowAddr" ':= PAddress
+               , "standingBidAddr" ':= PAddress
+               ]
+          )
+      )
+  deriving stock (Generic)
+  deriving anyclass (PlutusType, PIsData, PDataFields, PShow, PEq)
+
+instance DerivePlutusType PAuctionInfo where
+  type DPTStrat _ = PlutusTypeData

src/HydraAuctionOnchain/Types/AuctionInfo.hs

@@ -0,0 +1,38 @@
+module HydraAuctionOnchain.Types.AuctionTerms
+  ( PAuctionTerms (PAuctionTerms)
+  ) where
+
+import Plutarch.Api.V2
+  ( AmountGuarantees (Positive)
+  , KeyGuarantees (Sorted)
+  , PPOSIXTime
+  , PPubKeyHash
+  , PValue
+  )
+import Plutarch.DataRepr (PDataFields)
+
+newtype PAuctionTerms (s :: S)
+  = PAuctionTerms
+      ( Term
+          s
+          ( PDataRecord
+              '[ "auctionLot" ':= PValue 'Sorted 'Positive
+               , "sellerPkh" ':= PPubKeyHash
+               , "sellerVk" ':= PByteString
+               , "delegates" ':= PBuiltinList (PAsData PPubKeyHash)
+               , "biddingStart" ':= PPOSIXTime
+               , "biddingEnd" ':= PPOSIXTime
+               , "purchaseDeadline" ':= PPOSIXTime
+               , "cleanup" ':= PPOSIXTime
+               , "auctionFeePerDelegate" ':= PInteger
+               , "startingBid" ':= PInteger
+               , "minBidIncrement" ':= PInteger
+               , "minDepositAmount" ':= PInteger
+               ]
+          )
+      )
+  deriving stock (Generic)
+  deriving anyclass (PlutusType, PIsData, PDataFields, PShow, PEq)
+
+instance DerivePlutusType PAuctionTerms where
+  type DPTStrat _ = PlutusTypeData