From 3fe8acc19e1e3fcead721b49b376bf1bad940d4b Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Tue, 6 Sep 2022 16:21:45 +0100 Subject: [PATCH 1/5] Add listing contract, add test, restructure slightly --- index.d.ts | 7 ++ src/Seabug/CallContract.purs | 29 ++++++++ src/Seabug/Contract/MarketPlaceSell.purs | 73 ++++++++++++++++++++ src/Seabug/Contract/Mint.purs | 19 +++--- src/Seabug/Contract/Util.purs | 29 ++++---- test/Contract/Sell.purs | 86 ++++++++++++++++++++++++ test/Contract/Util.purs | 26 +++++-- test/Plutip.purs | 2 + 8 files changed, 246 insertions(+), 25 deletions(-) create mode 100644 src/Seabug/Contract/MarketPlaceSell.purs create mode 100644 test/Contract/Sell.purs diff --git a/index.d.ts b/index.d.ts index 7157ed5..0299ce7 100644 --- a/index.d.ts +++ b/index.d.ts @@ -1,5 +1,7 @@ export function callMarketPlaceBuy(config: Config, args: BuyNftArgs): Promise +export function callMarketPlaceSell(config: Config, args: SellArgs): + Promise export function callMarketPlaceListNft(config: Config): Promise> /** @@ -46,6 +48,11 @@ export type BuyNftArgs = { } +export type SellArgs = { + tokenCS: string, + tokenName: string +} + export type FetchNftArgs = Input export type NftCollectionArgs = { diff --git a/src/Seabug/CallContract.purs b/src/Seabug/CallContract.purs index 637dec5..d66cfff 100644 --- a/src/Seabug/CallContract.purs +++ b/src/Seabug/CallContract.purs @@ -4,6 +4,7 @@ module Seabug.CallContract , callMarketPlaceBuy , callMarketPlaceFetchNft , callMarketPlaceListNft + , callMarketPlaceSell , callMint ) where @@ -34,6 +35,7 @@ import Contract.Value import Control.Monad.Error.Class (throwError) import Control.Promise (Promise) import Control.Promise as Promise +import Data.Bifunctor (lmap) import Data.BigInt (BigInt) import Data.BigInt as BigInt import Data.Log.Level (LogLevel(..)) @@ -50,6 +52,7 @@ import Seabug.Contract.CnftMint (mintCnft) import Seabug.Contract.Common (NftResult) import Seabug.Contract.MarketPlaceFetchNft (marketPlaceFetchNft) import Seabug.Contract.MarketPlaceListNft (marketPlaceListNft) +import Seabug.Contract.MarketPlaceSell (marketPlaceSell) import Seabug.Contract.Mint (mintWithCollection) import Seabug.Metadata.Share (unShare) import Seabug.Metadata.Types (SeabugMetadata(SeabugMetadata)) @@ -134,6 +137,19 @@ callMarketPlaceListNft cfg = Promise.fromAff do listnft <- runContract contractConfig (marketPlaceListNft cfg.projectId) pure $ buildNftList contractConfig.networkId <$> listnft +-- | Calls Seabugs marketPlaceSell and takes care of converting data types. +-- | Returns a JS promise. +callMarketPlaceSell + :: ContractConfiguration -> SellArgs -> Effect (Promise Unit) +callMarketPlaceSell cfg args = Promise.fromAff do + contractConfig <- liftEither $ buildContractConfig cfg + sellArgs <- liftEither $ buildSellArgs args + runContract contractConfig do + txHash <- marketPlaceSell sellArgs + log $ "Waiting for confirmation of sell transaction: " <> show txHash + awaitTxConfirmed txHash + log $ "Sell transaction confirmed: " <> show txHash + -- | Configuation needed to call contracts from JS. type ContractConfiguration = { serverHost :: String @@ -202,6 +218,11 @@ type MintArgs = , price :: BigInt -- Natural } +type SellArgs = + { tokenCS :: String + , tokenName :: String + } + buildContractConfig :: ContractConfiguration -> Either Error (ConfigParams ()) buildContractConfig cfg = do @@ -382,6 +403,14 @@ buildMintArgs } pure (mintCnftParams /\ mintParams) +buildSellArgs :: SellArgs -> Either Error (CurrencySymbol /\ TokenName) +buildSellArgs { tokenCS, tokenName } = lmap error do + csBytes <- note "Failed to convert to bytes" $ hexToByteArray tokenCS + cs <- note "Failed to convert to currency symbol" $ mkCurrencySymbol csBytes + tnBytes <- note "Failed to convert to bytes" $ hexToByteArray tokenName + tn <- note "Failed to convert to token name" $ mkTokenName tnBytes + pure (cs /\ tn) + buildTransactionInput :: TransactionInputOut -> Either Error TransactionInput buildTransactionInput input = do transactionId <- diff --git a/src/Seabug/Contract/MarketPlaceSell.purs b/src/Seabug/Contract/MarketPlaceSell.purs new file mode 100644 index 0000000..6e2ea6e --- /dev/null +++ b/src/Seabug/Contract/MarketPlaceSell.purs @@ -0,0 +1,73 @@ +module Seabug.Contract.MarketPlaceSell + ( marketPlaceSell + ) where + +import Contract.Prelude + +import Contract.Address + ( getNetworkId + , ownPaymentPubKeyHash + , ownStakePubKeyHash + , payPubKeyHashBaseAddress + ) +import Contract.Monad (Contract, liftContractM, liftedE, liftedM) +import Contract.PlutusData (toData) +import Contract.ScriptLookups as Lookups +import Contract.Transaction (TransactionHash, balanceAndSignTxE, submit) +import Contract.TxConstraints as Constraints +import Contract.Utxos (utxosAt) +import Contract.Value + ( CurrencySymbol + , TokenName + , Value + , singleton + , valueOf + ) +import Data.BigInt (fromInt) +import Effect.Exception (throw) +import Seabug.MarketPlace (marketplaceValidator) +import Seabug.Types (MarketplaceDatum(..)) + +-- | Mint the self-governed NFT for the given collection. +marketPlaceSell + :: forall (r :: Row Type) + . CurrencySymbol /\ TokenName + -> Contract r TransactionHash +marketPlaceSell (curr /\ tn) = do + owner <- liftedM "Cannot get PaymentPubKeyHash" ownPaymentPubKeyHash + ownerStake <- liftedM "Cannot get StakePubKeyHash" ownStakePubKeyHash + networkId <- getNetworkId + addr <- liftContractM "Cannot get user address" $ + payPubKeyHashBaseAddress networkId owner ownerStake + utxos <- liftedM "Cannot get user utxos" $ utxosAt addr + marketplaceValidator' <- unwrap <$> marketplaceValidator + + let + hasToken :: Value -> Boolean + hasToken v = valueOf v curr tn == fromInt 1 + + callerHasToken :: Boolean + callerHasToken = any (unwrap >>> _.amount >>> hasToken) $ unwrap utxos + + nftValue :: Value + nftValue = singleton curr tn one + + lookups :: Lookups.ScriptLookups Void + lookups = Lookups.unspentOutputs (unwrap utxos) + + constraints :: Constraints.TxConstraints Void Void + constraints = + Constraints.mustPayToScript marketplaceValidator'.validatorHash + ( wrap $ toData $ MarketplaceDatum $ + { getMarketplaceDatum: curr /\ tn } + ) + nftValue + + unless callerHasToken $ liftEffect $ throw "Missing token" + + unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints + signedTx <- liftedE $ balanceAndSignTxE unbalancedTx + transactionHash <- submit signedTx + log $ "Sell transaction successfully submitted with hash: " <> show + transactionHash + pure transactionHash diff --git a/src/Seabug/Contract/Mint.purs b/src/Seabug/Contract/Mint.purs index c136b26..7dd66ab 100644 --- a/src/Seabug/Contract/Mint.purs +++ b/src/Seabug/Contract/Mint.purs @@ -28,7 +28,11 @@ import Contract.Value , scriptCurrencySymbol , singleton ) -import Seabug.Contract.Util (getSeabugMetadata) +import Seabug.Contract.Util + ( ReturnBehaviour(ToMarketPlace) + , getSeabugMetadata + , payBehaviour + ) import Seabug.Lock (mkLockScript) import Seabug.MarketPlace (marketplaceValidator) import Seabug.MintingPolicy as MintingPolicy @@ -44,13 +48,15 @@ import Seabug.Types mintWithCollectionTest :: forall (r :: Row Type) - . CurrencySymbol /\ TokenName + . ReturnBehaviour + -> CurrencySymbol /\ TokenName -> MintParams -> ( Constraints.TxConstraints Void Void -> Contract r (Constraints.TxConstraints Void Void) ) -> Contract r (TransactionHash /\ (CurrencySymbol /\ TokenName) /\ NftData) mintWithCollectionTest + retBehaviour (collectionNftCs /\ collectionNftTn) ( MintParams { price, lockLockup, lockLockupEnd, authorShare, daoShare } @@ -95,11 +101,8 @@ mintWithCollectionTest constraints = mconcat [ Constraints.mustMintValueWithRedeemer (wrap $ toData $ MintToken nft) nftValue - , Constraints.mustPayToScript marketplaceValidator'.validatorHash - ( wrap $ toData $ MarketplaceDatum - { getMarketplaceDatum: curr /\ tn } - ) - nftValue + , payBehaviour retBehaviour marketplaceValidator'.validatorHash + (curr /\ tn) , Constraints.mustPayToScript lockingScriptHash ( wrap $ toData $ LockDatum { sgNft: curr @@ -127,7 +130,7 @@ mintWithCollection' . CurrencySymbol /\ TokenName -> MintParams -> Contract r (TransactionHash /\ (CurrencySymbol /\ TokenName) /\ NftData) -mintWithCollection' c p = mintWithCollectionTest c p pure +mintWithCollection' c p = mintWithCollectionTest ToMarketPlace c p pure -- | Mint the self-governed NFT for the given collection. mintWithCollection diff --git a/src/Seabug/Contract/Util.purs b/src/Seabug/Contract/Util.purs index 65e48d8..d71c6ee 100644 --- a/src/Seabug/Contract/Util.purs +++ b/src/Seabug/Contract/Util.purs @@ -6,6 +6,7 @@ module Seabug.Contract.Util , modify , seabugTxToMarketTx , getSeabugMetadata + , payBehaviour ) where import Contract.Prelude @@ -61,6 +62,7 @@ import Seabug.Types , NftData(..) , NftId ) +import Types.Scripts (ValidatorHash) import Types.Transaction (TransactionInput) type SeabugTxData = @@ -78,6 +80,20 @@ modify fn t = wrap (fn (unwrap t)) data ReturnBehaviour = ToMarketPlace | ToCaller +payBehaviour + :: ReturnBehaviour + -> ValidatorHash + -> (Value.CurrencySymbol /\ Value.TokenName) + -> TxConstraints Void Void +payBehaviour ToCaller _ _ = mempty -- Balancing will return the token to the caller +payBehaviour ToMarketPlace valHash asset = + mustPayToScript + valHash + ( Datum $ toData $ + MarketplaceDatum { getMarketplaceDatum: asset } + ) + (Value.singleton (fst asset) (snd asset) one) + -- | Build and submit a transaction involving a given nft, specifying -- | if the nft should be sent to the current user or the marketplace. seabugTxToMarketTx @@ -106,22 +122,11 @@ seabugTxToMarketTx name retBehaviour mkTxData nftData = do [ ScriptLookups.typedValidatorLookups $ wrap marketplaceValidator' , ScriptLookups.validator marketplaceValidator'.validator ] - newNftValue = - Value.singleton (fst txData.newAsset) (snd txData.newAsset) one constraints :: TxConstraints Void Void constraints = txData.constraints <> mustSpendScriptOutput txData.inputUtxo unitRedeemer - <> - case retBehaviour of - ToMarketPlace -> - mustPayToScript - valHash - ( Datum $ toData $ - MarketplaceDatum { getMarketplaceDatum: txData.newAsset } - ) - newNftValue - ToCaller -> mempty -- Balancing will return the token to the caller + <> payBehaviour retBehaviour valHash txData.newAsset txDatumsRedeemerTxIns <- liftedE $ mkUnbalancedTx lookups constraints metadata <- liftContractE $ getSeabugMetadata diff --git a/test/Contract/Sell.purs b/test/Contract/Sell.purs new file mode 100644 index 0000000..defc75a --- /dev/null +++ b/test/Contract/Sell.purs @@ -0,0 +1,86 @@ +module Test.Contract.Sell (suite) where + +import Contract.Prelude + +import Contract.Address (getWalletAddress) +import Contract.Monad (Contract, liftedM) +import Contract.Test.Plutip (runPlutipContract, withKeyWallet, withStakeKey) +import Contract.Transaction (awaitTxConfirmed) +import Contract.Wallet (KeyWallet) +import Data.BigInt as BigInt +import Mote (group, test) +import Seabug.Contract.Buy (marketplaceBuy') +import Seabug.Contract.MarketPlaceSell (marketPlaceSell) +import Seabug.Contract.Util (ReturnBehaviour(ToCaller)) +import Seabug.MarketPlace (marketplaceValidatorAddr) +import Seabug.Types (MarketplaceDatum(..)) +import Test.Contract.Util + ( assertContract + , assertOutputHasDatum + , callMintCnft + , callMintSgNft' + , checkNftAtAddress + , findUtxoWithNft + , mintParams1 + , plutipConfig + , privateStakeKey1 + , privateStakeKey2 + ) +import TestM (TestPlanM) + +suite :: TestPlanM Unit +suite = + group "Sell" do + test "Successful Sell and rebuy" do + withMinterAndBuyer \minter buyer -> do + nftData <- withKeyWallet minter do + cnft <- callMintCnft pure + minterAddr <- liftedM "Could not get addr" getWalletAddress + assertContract "Could not find cnft at minter address" =<< + checkNftAtAddress cnft minterAddr + + { sgNft, nftData } <- callMintSgNft' ToCaller cnft mintParams1 pure + + assertContract "Could not find sgnft at minter address" =<< + checkNftAtAddress sgNft minterAddr + + log "Selling nft to market" + sellTxHash <- marketPlaceSell sgNft + awaitTxConfirmed sellTxHash + log $ "Sell transaction confirmed: " <> show sellTxHash + + scriptAddr <- marketplaceValidatorAddr + sgNftUtxo <- liftedM "Could not find sgNft at marketplace address" $ + findUtxoWithNft sgNft scriptAddr + + assertOutputHasDatum "sgNft" + (MarketplaceDatum { getMarketplaceDatum: sgNft }) + (==) + sgNftUtxo + + pure nftData + + withKeyWallet buyer do + buyerAddr <- liftedM "Could not get addr" getWalletAddress + log "Buying listed nft" + buyTxHash /\ txData <- marketplaceBuy' ToCaller nftData + awaitTxConfirmed buyTxHash + log $ "Buy transaction confirmed: " <> show buyTxHash + + assertContract "Could not find sgnft at buyer address" =<< + checkNftAtAddress txData.newAsset buyerAddr + +withMinterAndBuyer + :: forall (a :: Type). (KeyWallet -> KeyWallet -> Contract () a) -> Aff a +withMinterAndBuyer f = + runPlutipContract plutipConfig + ( withStakeKey privateStakeKey1 + [ BigInt.fromInt 1_000_000_000 + , BigInt.fromInt 2_000_000_000 + ] + /\ withStakeKey privateStakeKey2 + [ BigInt.fromInt 1_000_000_000 + , BigInt.fromInt 2_000_000_000 + ] + ) + \(minter /\ buyer) -> f minter buyer diff --git a/test/Contract/Util.purs b/test/Contract/Util.purs index 5699d1a..6de39a6 100644 --- a/test/Contract/Util.purs +++ b/test/Contract/Util.purs @@ -12,6 +12,7 @@ module Test.Contract.Util , assertTxHasMetadata , callMintCnft , callMintSgNft + , callMintSgNft' , checkBalanceChangeAtAddr , checkNftAtAddress , checkOutputHasDatum @@ -87,7 +88,7 @@ import Metadata.MetadataType (class MetadataType, metadataLabel) import Partial.Unsafe (unsafePartial) import Seabug.Contract.CnftMint (mintCnftTest) import Seabug.Contract.Mint (mintWithCollectionTest) -import Seabug.Contract.Util (modify) +import Seabug.Contract.Util (ReturnBehaviour(ToMarketPlace), modify) import Seabug.Types (MintCnftParams(..), MintParams, NftData) import Type.Proxy (Proxy(..)) import Types.BigNum as BigNum @@ -151,9 +152,10 @@ callMintCnft modConstraints = do log $ "Minted cnft: " <> show cnft pure cnft -callMintSgNft +callMintSgNft' :: forall (r :: Row Type) - . Tuple CurrencySymbol TokenName + . ReturnBehaviour + -> Tuple CurrencySymbol TokenName -> MintParams -> ( Constraints.TxConstraints Void Void -> Contract r (Constraints.TxConstraints Void Void) @@ -163,15 +165,29 @@ callMintSgNft , nftData :: NftData , txHash :: TransactionHash } -callMintSgNft cnft mintParams modConstraints = do +callMintSgNft' retBehaviour cnft mintParams modConstraints = do log "Minting sgNft..." txHash /\ sgNft /\ nftData <- - mintWithCollectionTest cnft mintParams modConstraints + mintWithCollectionTest retBehaviour cnft mintParams modConstraints log $ "Waiting for confirmation of nft transaction: " <> show txHash awaitTxConfirmed txHash log $ "Nft transaction confirmed: " <> show txHash pure { sgNft, nftData, txHash } +callMintSgNft + :: forall (r :: Row Type) + . Tuple CurrencySymbol TokenName + -> MintParams + -> ( Constraints.TxConstraints Void Void + -> Contract r (Constraints.TxConstraints Void Void) + ) + -> Contract r + { sgNft :: (CurrencySymbol /\ TokenName) + , nftData :: NftData + , txHash :: TransactionHash + } +callMintSgNft = callMintSgNft' ToMarketPlace + plutipConfig :: PlutipConfig plutipConfig = { host: "127.0.0.1" diff --git a/test/Plutip.purs b/test/Plutip.purs index 0856546..d091cfb 100644 --- a/test/Plutip.purs +++ b/test/Plutip.purs @@ -5,6 +5,7 @@ import Contract.Prelude import Contract.Monad (launchAff_) import Test.Contract.Buy as Buy import Test.Contract.Minting as Minting +import Test.Contract.Sell as Sell import Test.Spec.Runner (defaultConfig) import Test.Util (interpretWithConfig) import TestM (TestPlanM) @@ -21,3 +22,4 @@ plutipTestPlan :: TestPlanM Unit plutipTestPlan = do Minting.suite Buy.suite + Sell.suite From 4c3ec30d23fd0e3986fa06e11d6eb4dcd1c807ba Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Tue, 6 Sep 2022 16:27:29 +0100 Subject: [PATCH 2/5] Fix build --- src/Seabug/Contract/Mint.purs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Seabug/Contract/Mint.purs b/src/Seabug/Contract/Mint.purs index 7dd66ab..287edee 100644 --- a/src/Seabug/Contract/Mint.purs +++ b/src/Seabug/Contract/Mint.purs @@ -38,7 +38,6 @@ import Seabug.MarketPlace (marketplaceValidator) import Seabug.MintingPolicy as MintingPolicy import Seabug.Types ( LockDatum(..) - , MarketplaceDatum(..) , MintAct(..) , MintParams(..) , NftCollection(..) From c842064d250e3addfb79f029a22d525e559935f1 Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Tue, 6 Sep 2022 16:32:03 +0100 Subject: [PATCH 3/5] Slight improvement --- src/Seabug/CallContract.purs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Seabug/CallContract.purs b/src/Seabug/CallContract.purs index d66cfff..521a73c 100644 --- a/src/Seabug/CallContract.purs +++ b/src/Seabug/CallContract.purs @@ -405,10 +405,8 @@ buildMintArgs buildSellArgs :: SellArgs -> Either Error (CurrencySymbol /\ TokenName) buildSellArgs { tokenCS, tokenName } = lmap error do - csBytes <- note "Failed to convert to bytes" $ hexToByteArray tokenCS - cs <- note "Failed to convert to currency symbol" $ mkCurrencySymbol csBytes - tnBytes <- note "Failed to convert to bytes" $ hexToByteArray tokenName - tn <- note "Failed to convert to token name" $ mkTokenName tnBytes + cs <- note "Failed to convert to currency symbol" $ mkCurrencySymbol =<< hexToByteArray tokenCS + tn <- note "Failed to convert to token name" $ mkTokenName =<< hexToByteArray tokenName pure (cs /\ tn) buildTransactionInput :: TransactionInputOut -> Either Error TransactionInput From 94b79918c041a11022acc527e3c6d3c233b148b7 Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Wed, 7 Sep 2022 10:23:08 +0100 Subject: [PATCH 4/5] Add min utxo value, support non stake addresses --- src/Seabug/CallContract.purs | 6 ++++-- src/Seabug/Contract/Buy.purs | 6 +++--- src/Seabug/Contract/MarketPlaceListNft.purs | 4 ++-- src/Seabug/Contract/MarketPlaceSell.purs | 13 ++----------- src/Seabug/Contract/Mint.purs | 13 ++++--------- src/Seabug/Contract/Util.purs | 18 ++++++++++-------- test/Contract/Buy.purs | 4 ++-- test/Contract/Minting.purs | 4 ++-- 8 files changed, 29 insertions(+), 39 deletions(-) diff --git a/src/Seabug/CallContract.purs b/src/Seabug/CallContract.purs index 521a73c..d39c466 100644 --- a/src/Seabug/CallContract.purs +++ b/src/Seabug/CallContract.purs @@ -405,8 +405,10 @@ buildMintArgs buildSellArgs :: SellArgs -> Either Error (CurrencySymbol /\ TokenName) buildSellArgs { tokenCS, tokenName } = lmap error do - cs <- note "Failed to convert to currency symbol" $ mkCurrencySymbol =<< hexToByteArray tokenCS - tn <- note "Failed to convert to token name" $ mkTokenName =<< hexToByteArray tokenName + cs <- note "Failed to convert to currency symbol" $ mkCurrencySymbol =<< + hexToByteArray tokenCS + tn <- note "Failed to convert to token name" $ mkTokenName =<< hexToByteArray + tokenName pure (cs /\ tn) buildTransactionInput :: TransactionInputOut -> Either Error TransactionInput diff --git a/src/Seabug/Contract/Buy.purs b/src/Seabug/Contract/Buy.purs index a0fbe07..3bf573c 100644 --- a/src/Seabug/Contract/Buy.purs +++ b/src/Seabug/Contract/Buy.purs @@ -22,7 +22,7 @@ import Plutus.Types.Transaction (UtxoM) import Seabug.Contract.Util ( ReturnBehaviour(..) , SeabugTxData - , minAdaOnlyUTxOValue + , minUTxOValue , mkChangeNftIdTxData , modify , seabugTxToMarketTx @@ -54,7 +54,7 @@ mkBuyTxData nftData mScriptUtxos = do shareToSubtract :: BigInt -> BigInt shareToSubtract v - | v < minAdaOnlyUTxOValue = zero + | v < minUTxOValue = zero | otherwise = v filterLowValue @@ -62,7 +62,7 @@ mkBuyTxData nftData mScriptUtxos = do -> (Value.Value -> TxConstraints Void Void) -> TxConstraints Void Void filterLowValue v t - | v < minAdaOnlyUTxOValue = mempty + | v < minUTxOValue = mempty | otherwise = t (Value.lovelaceValueOf v) authorShare = getShare $ toBigInt nftCollection.authorShare diff --git a/src/Seabug/Contract/MarketPlaceListNft.purs b/src/Seabug/Contract/MarketPlaceListNft.purs index 2f89ae3..bf610bf 100644 --- a/src/Seabug/Contract/MarketPlaceListNft.purs +++ b/src/Seabug/Contract/MarketPlaceListNft.purs @@ -17,7 +17,7 @@ import Control.Parallel (parTraverse) import Data.Array (catMaybes, mapMaybe) import Data.Map as Map import Seabug.Contract.Common (NftResult) -import Seabug.Contract.Util (minAdaOnlyUTxOValue) +import Seabug.Contract.Util (minUTxOValue) import Seabug.MarketPlace (marketplaceValidatorAddr) import Seabug.Metadata (getFullSeabugMetadataWithBackoff) import Seabug.Types (MarketplaceDatum(MarketplaceDatum)) @@ -51,6 +51,6 @@ marketPlaceListNft projectId = do -- I put too low. The old nfts are caught above because their -- metadata won't be parsed. guard $ (unwrap metadata.seabugMetadata # _.ownerPrice) >= - (Natural.fromBigInt' minAdaOnlyUTxOValue) + (Natural.fromBigInt' minUTxOValue) pure { input, output, metadata } pure $ catMaybes withMetadata diff --git a/src/Seabug/Contract/MarketPlaceSell.purs b/src/Seabug/Contract/MarketPlaceSell.purs index 6e2ea6e..a675aea 100644 --- a/src/Seabug/Contract/MarketPlaceSell.purs +++ b/src/Seabug/Contract/MarketPlaceSell.purs @@ -4,12 +4,7 @@ module Seabug.Contract.MarketPlaceSell import Contract.Prelude -import Contract.Address - ( getNetworkId - , ownPaymentPubKeyHash - , ownStakePubKeyHash - , payPubKeyHashBaseAddress - ) +import Contract.Address (getWalletAddress) import Contract.Monad (Contract, liftContractM, liftedE, liftedM) import Contract.PlutusData (toData) import Contract.ScriptLookups as Lookups @@ -34,11 +29,7 @@ marketPlaceSell . CurrencySymbol /\ TokenName -> Contract r TransactionHash marketPlaceSell (curr /\ tn) = do - owner <- liftedM "Cannot get PaymentPubKeyHash" ownPaymentPubKeyHash - ownerStake <- liftedM "Cannot get StakePubKeyHash" ownStakePubKeyHash - networkId <- getNetworkId - addr <- liftContractM "Cannot get user address" $ - payPubKeyHashBaseAddress networkId owner ownerStake + addr <- liftedM "Cannot get address" getWalletAddress utxos <- liftedM "Cannot get user utxos" $ utxosAt addr marketplaceValidator' <- unwrap <$> marketplaceValidator diff --git a/src/Seabug/Contract/Mint.purs b/src/Seabug/Contract/Mint.purs index 287edee..2defb04 100644 --- a/src/Seabug/Contract/Mint.purs +++ b/src/Seabug/Contract/Mint.purs @@ -7,14 +7,12 @@ module Seabug.Contract.Mint import Contract.Prelude import Contract.Address - ( getNetworkId - , ownPaymentPubKeyHash - , ownStakePubKeyHash - , payPubKeyHashBaseAddress + ( ownPaymentPubKeyHash + , getWalletAddress ) import Contract.AuxiliaryData (setTxMetadata) import Contract.Chain (currentSlot, currentTime) -import Contract.Monad (Contract, liftContractE, liftContractM, liftedE, liftedM) +import Contract.Monad (Contract, liftContractE, liftedE, liftedM) import Contract.PlutusData (toData) import Contract.ScriptLookups as Lookups import Contract.Scripts (validatorHash) @@ -62,10 +60,7 @@ mintWithCollectionTest ) modConstraints = do owner <- liftedM "Cannot get PaymentPubKeyHash" ownPaymentPubKeyHash - ownerStake <- liftedM "Cannot get StakePubKeyHash" ownStakePubKeyHash - networkId <- getNetworkId - addr <- liftContractM "Cannot get user address" $ - payPubKeyHashBaseAddress networkId owner ownerStake + addr <- liftedM "Cannot get address" getWalletAddress utxos <- liftedM "Cannot get user utxos" $ utxosAt addr marketplaceValidator' <- unwrap <$> marketplaceValidator lockingScript <- mkLockScript collectionNftCs lockLockup lockLockupEnd diff --git a/src/Seabug/Contract/Util.purs b/src/Seabug/Contract/Util.purs index d71c6ee..f09cf37 100644 --- a/src/Seabug/Contract/Util.purs +++ b/src/Seabug/Contract/Util.purs @@ -1,12 +1,12 @@ module Seabug.Contract.Util - ( SeabugTxData - , ReturnBehaviour(..) - , minAdaOnlyUTxOValue + ( ReturnBehaviour(..) + , SeabugTxData + , getSeabugMetadata + , minUTxOValue , mkChangeNftIdTxData , modify - , seabugTxToMarketTx - , getSeabugMetadata , payBehaviour + , seabugTxToMarketTx ) where import Contract.Prelude @@ -92,7 +92,9 @@ payBehaviour ToMarketPlace valHash asset = ( Datum $ toData $ MarketplaceDatum { getMarketplaceDatum: asset } ) - (Value.singleton (fst asset) (snd asset) one) + ( Value.singleton (fst asset) (snd asset) one <> Value.lovelaceValueOf + minUTxOValue + ) -- | Build and submit a transaction involving a given nft, specifying -- | if the nft should be sent to the current user or the marketplace. @@ -213,8 +215,8 @@ mkChangeNftIdTxData name act mapNft (NftData nftData) mScriptUtxos = do , newNft: newNft } -minAdaOnlyUTxOValue :: BigInt -minAdaOnlyUTxOValue = BigInt.fromInt 2_000_000 +minUTxOValue :: BigInt +minUTxOValue = BigInt.fromInt 2_000_000 -- | Set metadata on the transaction for the given NFT getSeabugMetadata diff --git a/test/Contract/Buy.purs b/test/Contract/Buy.purs index 1add105..f792014 100644 --- a/test/Contract/Buy.purs +++ b/test/Contract/Buy.purs @@ -27,7 +27,7 @@ import Seabug.Contract.Util ( ReturnBehaviour(..) , SeabugTxData , getSeabugMetadata - , minAdaOnlyUTxOValue + , minUTxOValue , modify ) import Seabug.MarketPlace (marketplaceValidatorAddr) @@ -366,7 +366,7 @@ buyerMarketplaceUtxoAssert assertPaymentUtxo :: String -> Address -> BigInt -> PostBuyTestData -> Contract () Unit assertPaymentUtxo name addr payment { txData: { oldAsset } } - | payment < minAdaOnlyUTxOValue = pure unit + | payment < minUTxOValue = pure unit | otherwise = assertContract (name <> " did not have payment utxo with datum") =<< isJust diff --git a/test/Contract/Minting.purs b/test/Contract/Minting.purs index 906572a..57de286 100644 --- a/test/Contract/Minting.purs +++ b/test/Contract/Minting.purs @@ -15,7 +15,7 @@ import Contract.Wallet (KeyWallet) import Data.BigInt as BigInt import Data.FoldableWithIndex (findWithIndex) import Mote (group, test) -import Seabug.Contract.Util (getSeabugMetadata, minAdaOnlyUTxOValue, modify) +import Seabug.Contract.Util (getSeabugMetadata, minUTxOValue, modify) import Seabug.Lock (mkLockScript) import Seabug.MarketPlace (marketplaceValidatorAddr) import Seabug.Types (LockDatum(..), MarketplaceDatum(..)) @@ -90,7 +90,7 @@ suite = (MustPayToScript h d _) | h == lockingScriptHash -> pure $ MustPayToScript h d - (lovelaceValueOf minAdaOnlyUTxOValue) + (lovelaceValueOf minUTxOValue) x -> pure x pure $ modify (_ { constraints = constraints' }) txc From 2aaa1a31bd5926aa96a307bfb52f213a84f14bfa Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Wed, 21 Sep 2022 10:34:49 +0100 Subject: [PATCH 5/5] Fix warning --- src/Seabug/Contract/MarketPlaceSell.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Seabug/Contract/MarketPlaceSell.purs b/src/Seabug/Contract/MarketPlaceSell.purs index a675aea..65dc03d 100644 --- a/src/Seabug/Contract/MarketPlaceSell.purs +++ b/src/Seabug/Contract/MarketPlaceSell.purs @@ -5,7 +5,7 @@ module Seabug.Contract.MarketPlaceSell import Contract.Prelude import Contract.Address (getWalletAddress) -import Contract.Monad (Contract, liftContractM, liftedE, liftedM) +import Contract.Monad (Contract, liftedE, liftedM) import Contract.PlutusData (toData) import Contract.ScriptLookups as Lookups import Contract.Transaction (TransactionHash, balanceAndSignTxE, submit)