From 0718aa551382e9b1ad0c360b9bb750688bd939ef Mon Sep 17 00:00:00 2001 From: mesudip Date: Tue, 8 Jun 2021 22:50:27 +0545 Subject: [PATCH] Adds utility endpoints for marketplace operation --- dquadrant/nft/pab/Main.hs | 2 +- dquadrant/nft/plutus-tokens.cabal | 3 +- .../Plutus/Contract/Blockchain/MarketPlace.hs | 358 ++++++++++++++---- .../src/Plutus/Contract/Blockchain/Param.hs | 66 ++++ .../nft/src/Plutus/Contract/Wallet/Utility.hs | 55 +++ 5 files changed, 413 insertions(+), 71 deletions(-) create mode 100644 dquadrant/nft/src/Plutus/Contract/Blockchain/Param.hs create mode 100644 dquadrant/nft/src/Plutus/Contract/Wallet/Utility.hs diff --git a/dquadrant/nft/pab/Main.hs b/dquadrant/nft/pab/Main.hs index 9dea80c09..20ebc8797 100644 --- a/dquadrant/nft/pab/Main.hs +++ b/dquadrant/nft/pab/Main.hs @@ -68,7 +68,7 @@ waitForLast cid = _ -> Nothing wallets :: [Wallet] -wallets = [Wallet i | i <- [1 .. 9]] +wallets = [Wallet i | i <- [1 .. 5]] defaultMarket :: Market defaultMarket = Market diff --git a/dquadrant/nft/plutus-tokens.cabal b/dquadrant/nft/plutus-tokens.cabal index 6638dd2d9..5ee45b2cd 100644 --- a/dquadrant/nft/plutus-tokens.cabal +++ b/dquadrant/nft/plutus-tokens.cabal @@ -45,7 +45,8 @@ library lens, text, containers, - utf8-string + utf8-string, + string-conversions hs-source-dirs: src default-language: Haskell2010 ghc-options: diff --git a/dquadrant/nft/src/Plutus/Contract/Blockchain/MarketPlace.hs b/dquadrant/nft/src/Plutus/Contract/Blockchain/MarketPlace.hs index 56bab725a..23ba59bc9 100644 --- a/dquadrant/nft/src/Plutus/Contract/Blockchain/MarketPlace.hs +++ b/dquadrant/nft/src/Plutus/Contract/Blockchain/MarketPlace.hs @@ -35,8 +35,20 @@ import qualified PlutusTx.AssocMap as AssocMap import PlutusTx.Prelude hiding (Semigroup(..), unless) import Ledger hiding (singleton,fee) import qualified PlutusTx.Prelude as PlutusPrelude -import Ledger.Constraints as Constraints +import Ledger.Constraints as Constraints + ( monetaryPolicy, + otherScript, + unspentOutputs, + mustForgeValue, + mustPayToOtherScript, + mustPayToPubKey, + mustPayToTheScript, + mustSpendPubKeyOutput, + mustSpendScriptOutput, + ScriptLookups, + TxConstraints ) import qualified Ledger.Typed.Scripts as Scripts +import qualified Ledger.Scripts import Ledger.Value as Value import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema, adaCurrency) import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) @@ -46,7 +58,12 @@ import Prelude (Semigroup (..), Show (show), String) import Text.Printf (printf) import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.UTF8 -import Data.Aeson (FromJSON, ToJSON, Value (Bool)) +import qualified Data.ByteString.Lazy.Internal as Lazy +import qualified Data.Sequence as Seq +import Data.String.Conversions +import Data.Aeson (FromJSON, ToJSON (toEncoding), Value (Bool), encode) +import qualified Data.Aeson.Types as Types + import Ledger.Ada import qualified Ledger.Ada as Ada import Data.Semigroup (Last) @@ -54,18 +71,31 @@ import PlutusTx.These import qualified Data.ByteString as Builtins import qualified Data.ByteString.UTF8 as U8 import qualified Plutus.Contract as Extras +import qualified Data.Void as Data +import Data.Aeson.Types +import qualified Data.Aeson.Extras as JSON +import Data.ByteString.Lazy (toStrict) +import Ledger.AddressMap +import qualified Data.Map +import Data.Functor + newtype Payment = Payment ( AssocMap.Map PubKeyHash Ledger.Value ) deriving stock (Generic) deriving anyclass (ToJSON, FromJSON) deriving Show - +data ResponseTypes = Funds| MarketNfts|OwnNftsOnSale |Minted|PlacedOnMarket|Bought deriving(Generic,Prelude.Eq,Prelude.Show,ToJSON,FromJSON) +data ApiResponse t = APISequence { + sequence :: Integer, + contentType::ResponseTypes, + content :: t + } + deriving (Generic,Prelude.Eq ,Prelude.Show,ToJSON,FromJSON) instance PlutusPrelude.Semigroup Payment where {-# INLINABLE (<>) #-} (<>) = combinePayments - {-# INLINABLE combinePayments #-} combinePayments :: Payment -> Payment -> Payment combinePayments (Payment a) (Payment b) = Payment (a PlutusPrelude.<> b) @@ -108,21 +138,29 @@ data Market = Market , fee :: !Integer } deriving (Show,Generic, FromJSON, ToJSON, Prelude.Eq) +data AssetId=AssetId + { + assCurrency :: !ByteString, + assToken:: String + } deriving(Generic, ToJSON,FromJSON,Prelude.Show,ToSchema ) instance ToSchema AssetClass data SellParams =SellParams { - spCurrency :: !String, + spCurrency :: !ByteString , spToken :: !String, spCost :: !Integer } deriving(GHC.Generics.Generic ,ToJSON,FromJSON,ToSchema) +spAsset :: SellParams -> AssetClass spAsset sp@SellParams{spCost,spCurrency,spToken}= assetClass currency token where - currency=currencySymbol $ U8.fromString spCurrency - token= tokenName $ U8.fromString spToken + currency= currencySymbol spCurrency + token=tokenName (convertString spToken) + -- currency=currencySymbol $ U8.fromString spCurrency + -- token= tokenName $ U8.fromString spToken data MintParams = MintParams @@ -138,7 +176,10 @@ data MarketAction = Showcase | Buy | ClaimFees deriving (FromJSON,ToJSON,Show,Ge PlutusTx.makeLift ''MarketAction PlutusTx.unstableMakeIsData ''MarketAction -newtype MarketUtxoData=MarketUtxoData{ unmarketUtxoData::Maybe (Integer,PubKeyHash)} +newtype MarketUtxoData=MarketUtxoData{ + unmarketUtxoData::Maybe (Integer,PubKeyHash) + }deriving (Generic,FromJSON,ToJSON,Show) + PlutusTx.unstableMakeIsData ''MarketUtxoData PlutusTx.makeLift ''MarketUtxoData @@ -152,6 +193,15 @@ marketUtxoData cost=do marketUtxoCost :: MarketUtxoData -> Ledger.Value marketUtxoCost (MarketUtxoData (Just (cost,_))) = lovelaceValueOf cost +maybeMarketUtxoData :: TxOutTx -> Maybe MarketUtxoData +maybeMarketUtxoData o =marketData (txOutTxOut o) $ \dh -> Map.lookup dh $ txData $ txOutTxTx o + where + marketData :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe MarketUtxoData + marketData o f = do + dh <- txOutDatum o + Datum d <- f dh + PlutusTx.fromData d + {-# INLINABLE emptyMarketUtxoData #-} emptyMarketUtxoData :: MarketUtxoData emptyMarketUtxoData=MarketUtxoData Nothing @@ -212,102 +262,272 @@ marketAddress :: Market -> Ledger.Address marketAddress = scriptAddress . marketValidator moveToMarket' :: forall s e. ( HasBlockchainActions s, - AsContractError e ) + AsContractError e ) =>Market -> AssetClass ->Integer - -> Contract [MarketOperation] s e () + -> Contract [Data.Aeson.Types.Value] s e Data.Aeson.Types.Value moveToMarket' market@Market{operator=operator,fee=fee} asset price= do - Contract.logInfo @String "Oh yeh, doing the move" - cost <- marketUtxoData fee - ledgerTx <- submitTxConstraints inst (Constraints.mustPayToTheScript cost value) - tell [MarketOperation "PutOnSale" asset price] - Extras.logInfo @String "yeh we did it" - -- awaitTxConfirmed ( txId ledgerTx) - Contract.logInfo @String "Yeh it's confirmed" + utxoData <- marketUtxoData price + ledgerTx <- submitTxConstraints inst (Constraints.mustPayToTheScript utxoData value) + Extras.logInfo @String "Sell transaction submitted" + awaitTxConfirmed ( txId ledgerTx) + tell [toJSON @String "Moved to market"] + Contract.logInfo @String "Sell transaction confirmed" + pure Types.Null -- return $ txId ledgeTx where value = assetClassValue asset 1 inst = marketScript market moveToMarket :: forall w s e. (HasBlockchainActions s,AsContractError e ) - =>Market -> SellParams -> Contract [MarketOperation] s e () + =>Market -> SellParams -> Contract [Data.Aeson.Types.Value] s e Data.Aeson.Types.Value moveToMarket market sp= moveToMarket' market (spAsset sp) (spCost sp) -buyFromMarket :: forall w s. HasBlockchainActions s => Market -> AssetClass -> Contract [MarketOperation] s Text () +buyFromMarket :: forall w s. HasBlockchainActions s => Market -> AssetId -> Contract [Data.Aeson.Types.Value] s Text Data.Aeson.Types.Value buyFromMarket market asset = do - utxoInfo <- findInMarket market asset + logInfo @String $ "requested buy" + utxoInfo <- findInMarket market $ AssetClass (CurrencySymbol (assCurrency asset) ,TokenName ( convertString (assToken asset))) case utxoInfo of - Nothing -> do - logError @String $ "It was either not on sale or is not on sale anymore " ++ show asset - Just (oref, o, cost) -> do - cost<-marketUtxoData cost - let tx = Constraints.mustPayToTheScript emptyMarketUtxoData (marketUtxoCost cost) <> - Constraints.mustSpendScriptOutput oref (Redeemer ( PlutusTx.toData Buy)) + Just (oref, o, (cost,seller)) -> do + logInfo @String $ "What we are consuming" ++ show o + logInfo @String $ "What we are providing" ++ show (marketScript market) + let tx = Constraints.mustSpendScriptOutput oref (Redeemer ( PlutusTx.toData Buy)) + <> Constraints.mustPayToPubKey seller (lovelaceValueOf cost) + -- <> Constraints.mustPayToOtherScript (validatorHash $ marketValidator market) (Ledger.Scripts.Datum $ PlutusTx.List [] ) (Ada.lovelaceValueOf 2) lookups = Constraints.unspentOutputs (Map.singleton oref o) <> - Constraints.scriptInstanceLookups (marketScript market) + Constraints.otherScript (marketValidator market) + logInfo @String $ "beginning to submit purchase" ledgerTx <- submitTxConstraintsWith @MarketType lookups tx + logInfo @String $ "Selectedfor purchase" awaitTxConfirmed $ txId ledgerTx - logInfo @String $ "Bought asset "++ show asset ++ "at the cost of " ++ show (marketUtxoCost cost) ++" Lovelace" + logInfo @String $ "Bought asset "++ show asset ++ "at the cost of " ++ show cost ++" Lovelace" + pure $ toJSON @String $ "Bought asset "++ show asset ++ "at the cost of " ++ show cost ++" Lovelace" + _ -> do + logError @String $ "It was either not on sale or is not on sale anymore " ++ show asset + pure $ toJSON @String $ "Asset not found in market" + + findInMarket :: forall w s. HasBlockchainActions s => - Market -> AssetClass - -> Contract [MarketOperation] s Text (Maybe (TxOutRef, TxOutTx, Integer)) + Market -> AssetClass + -> Contract w s Text (Maybe (TxOutRef, TxOutTx, (Integer,PubKeyHash))) findInMarket market asset = do - utxos <- Map.filter hasAsset <$> utxoAt (marketAddress market) - return $ case Map.toList utxos of - [(oref, o)] -> do - x <- nftCost (txOutTxOut o) $ \dh -> Map.lookup dh $ txData $ txOutTxTx o - return (oref, o, x) + utxos <- Map.filter hasAsset PlutusPrelude.<$> utxoAt (marketAddress market) + pure $ case Map.toList utxos of + [(oref, o)] -> case maybeMarketUtxoData o of + Just d@MarketUtxoData{unmarketUtxoData=(Just a)} -> Just (oref,o,a) + _ -> Nothing _ -> Nothing where + cost o = do + x<-maybeMarketUtxoData o + unmarketUtxoData x + hasAsset :: TxOutTx -> Bool hasAsset o = assetClassValueOf (txOutValue $ txOutTxOut o) asset == 1 - nftCost :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe Integer - nftCost o f = do - dh <- txOutDatum o - Datum d <- f dh - PlutusTx.fromData d --- myNFTsOnSale :: forall w s. HasBlockchainActions s => --- Market -> Contract w s Text (Maybe (TxOutRef, TxOutTx, Integer)) --- myNFTsOnSale market=do --- utxos <- Map.filter isMine <$> utxoAt (marketAddress market) --- return $ case Map.toList utxos of --- [(oref, o)] -> do --- x <- nftCost (txOutTxOut o) $ \dh -> Map.lookup dh $ txData $ txOutTxTx o --- return (oref, o, x) --- _ -> Nothing --- where --- isMine :: TxOut -> Bool --- isMine utxo= txOutDatumHash - --- findOwner :: TxOut ->Maybe PubKeyHash --- findOwner txOut= do --- dHash<-txOutDatumHash txOut --- datum<-findDatum dHash info --- marketUtxoData <-PlutusTx.fromData (getDatum datum) --- (case marketUtxoData of --- MarketUtxoData (Just(_,pk)) ->Just pk --- _ -> Nothing) +data ValueInfo=ValueInfo{ + currency::ByteString, + token:: String, + value:: Integer +} deriving(Generic,FromJSON,ToJSON,Prelude.Show) + +data NftsOnSaleResponse=NftsOnSaleResponse{ + cost::Integer, + owner:: ByteString, + values:: [ValueInfo] +}deriving(Generic,FromJSON,ToJSON,Prelude.Show) + +toValueInfo::Ledger.Value ->[ValueInfo] +toValueInfo v=map doMap $ flattenValue v + where + doMap (c,t,v)=ValueInfo (unCurrencySymbol c) (convertString (unTokenName t)) v + +utxosOnSale :: forall w s. HasBlockchainActions s => + Market -> Contract w s Text (Map.Map TxOutRef (TxOutTx, MarketUtxoData)) +utxosOnSale market=do + utxos<-utxoAt (marketAddress market) + let responses = filterSales utxos + return responses + where + filterSales:: UtxoMap ->Data.Map.Map TxOutRef (TxOutTx, MarketUtxoData) + filterSales m =Map.mapMaybeWithKey doMap m + + doMap:: TxOutRef -> TxOutTx ->Maybe (TxOutTx, MarketUtxoData) + doMap txOutRef txOutTx =case maybeMarketUtxoData txOutTx of + Just x-> Just (txOutTx,x) + _ -> Nothing +nftsOnSale :: forall w s. HasBlockchainActions s => + Market -> Contract w s Text [NftsOnSaleResponse] +nftsOnSale market = do + utxos <- utxosOnSale market + pure $ map doMap $ Map.elems utxos + where + doMap:: (TxOutTx,MarketUtxoData) -> NftsOnSaleResponse + doMap (TxOutTx _ txOut,MarketUtxoData{unmarketUtxoData=Just (c,pkh)})= NftsOnSaleResponse c ( getPubKeyHash pkh) (toValueInfo (txOutValue txOut)) + + +myUtxosOnSale :: forall w s. HasBlockchainActions s => + Market ->PubKeyHash -> Contract w s Text (Map.Map TxOutRef (TxOutTx, MarketUtxoData)) +myUtxosOnSale market pubKeyHash=do + onsale <- utxosOnSale market + pure $ Map.filter (belongsTo pubKeyHash) onsale + where + belongsTo :: PubKeyHash -> (TxOutTx,MarketUtxoData) -> Bool + belongsTo pk utxoData@(a,utxo)= isOwner pk utxo + + isOwner :: PubKeyHash ->MarketUtxoData ->Bool + isOwner _pk MarketUtxoData{unmarketUtxoData=(Just (_,pk))}= _pk==pk + isOwner _ _ = False + +myNftsOnSale :: forall w s. HasBlockchainActions s => + Market ->PubKeyHash-> Contract w s Text [NftsOnSaleResponse] +myNftsOnSale market pubKeyHash = do + utxos <- myUtxosOnSale market pubKeyHash + pure $ map doMap $ Map.elems utxos + where + doMap:: (TxOutTx,MarketUtxoData) -> NftsOnSaleResponse + doMap (TxOutTx _ txOut,MarketUtxoData{unmarketUtxoData=Just (c,pkh)})= NftsOnSaleResponse c (getPubKeyHash pkh) (toValueInfo (txOutValue txOut)) + type MarketSchema = BlockchainActions .\/ Endpoint "sell" SellParams --- .\/ Endpoint "withdraw" (AssetClass) - .\/ Endpoint "buy" AssetClass --- .\/ Endpoint "collect" () +-- .\/ Endpoint "withdraw" (AssetClass) + .\/ Endpoint "buy" AssetId + .\/ Endpoint "funds" String + .\/ Endpoint "mint" String + .\/ Endpoint "onsale" String + .\/ Endpoint "myonsale" String mkSchemaDefinitions ''MarketSchema -endpoints :: Market -> Contract [MarketOperation] MarketSchema Text () -endpoints market = ( - moveToMarket'' - `select` buyFromMarket'' - ) >> endpoints market + +endpoints :: Market -> Contract [Types.Value] MarketSchema Text () +endpoints market = handled >> endpoints market where + handled =handleError handler (selections >> pure ()) + selections=moveToMarket'' + `select`buyFromMarket'' + `select` ownFunds'' + `select` mintEp'' + `select` onsale'' + `select` myonsale'' buyFromMarket''= (endpoint @"buy") >>=buyFromMarket market moveToMarket''= (endpoint @"sell") >>= moveToMarket market + ownFunds'' = (endpoint @"funds") >> ownFunds + mintEp'' = (endpoint @"mint") >>= (\x -> pure (TokenName (convertString x)))>>= mintEp + onsale'' = (endpoint @"onsale") >> nftsOnSaleEp market + myonsale''= (endpoint @"myonsale") >> myNftsOnSaleEp market + handler e = do + Contract.logError $ show e + + +myNftsOnSaleEp :: (HasBlockchainActions s) => Market-> Contract [Types.Value ] s Text Types.Value +myNftsOnSaleEp m=do + pk<-ownPubKey + d<-myNftsOnSale m (pubKeyHash pk) + let ret=toJSON d + tell [ret] + return ret + +nftsOnSaleEp :: (HasBlockchainActions s) => Market-> Contract [Types.Value ] s Text Types.Value +nftsOnSaleEp m=do + pk<-ownPubKey + d <- nftsOnSale m + let ret=toJSON d + tell [ret] + return ret + + +instance ToJSON Lazy.ByteString where + toEncoding bs = + toEncoding $ Types.String (doConvert bs) + + toJSON bs = Types.String (doConvert bs) + + + +doConvert::Lazy.ByteString ->Text +doConvert=convertString + + +--Utility to get Own funds +-- +-- +-- + +ownFunds:: (HasBlockchainActions s) => Contract [Types.Value ] s Text Data.Aeson.Types.Value +ownFunds = do + pk <- ownPubKey + utxos <- utxoAt $ pubKeyAddress pk + let v = mconcat $ Map.elems $ txOutValue . txOutTxOut Prelude.<$> utxos + logInfo @String $ "own funds: " ++ show (Value.flattenValue v) + tell $ [ toJSON v] +-- let's hope that in future we can return the json string without having to tell + return $ toJSON v + + +---NFT Token Part Below +--- +--- + +{-# INLINABLE mkPolicy #-} +mkPolicy :: TxOutRef -> TokenName -> ScriptContext -> Bool +mkPolicy oref tn ctx@ScriptContext {scriptContextTxInfo=info@TxInfo{}} = + traceIfFalse "UTxO not consumed" hasUTxO && + traceIfFalse "wrong amount minted" checkMintedAmount + where + hasUTxO :: Bool + hasUTxO = any (\i -> txInInfoOutRef i == oref) $ txInfoInputs info + + checkMintedAmount :: Bool + checkMintedAmount = case flattenValue (txInfoForge info) of + [(cs, tn', amt)] -> cs == ownCurrencySymbol ctx && tn' == tn && amt == 1 + _ -> False + +policy :: TxOutRef -> TokenName -> Scripts.MonetaryPolicy +policy oref tn = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \oref' tn' -> Scripts.wrapMonetaryPolicy $ mkPolicy oref' tn' ||]) + `PlutusTx.applyCode` + PlutusTx.liftCode oref + `PlutusTx.applyCode` + PlutusTx.liftCode tn + +curSymbol :: TxOutRef -> TokenName -> CurrencySymbol +curSymbol oref tn = scriptCurrencySymbol $ policy oref tn + + + +mint :: (HasBlockchainActions s) => + TokenName -> Contract w s Text (Maybe (ScriptLookups a, TxConstraints i o)) +mint tn = do + pk <- Contract.ownPubKey + utxos <- utxoAt (pubKeyAddress pk) + case Map.keys utxos of + [] -> Contract.logError @String "no utxo found" >> pure Nothing + oref : _ -> do + let val = Value.singleton (curSymbol oref tn) tn 1 + lookups = Constraints.monetaryPolicy (policy oref tn) <> Constraints.unspentOutputs utxos + tx = Constraints.mustForgeValue val <> Constraints.mustSpendPubKeyOutput oref + pure $ Just (lookups,tx) + +mintEp :: (HasBlockchainActions s) =>TokenName -> Contract [Types.Value ] s Text Types.Value +mintEp tn=do + pk <- Contract.ownPubKey + utxos <- utxoAt (pubKeyAddress pk) + case Map.keys utxos of + [] -> Contract.logError @String "no utxo found" >> pure Types.Null + oref : _ -> do + let val = Value.singleton (curSymbol oref tn) tn 1 + lookups = Constraints.monetaryPolicy (policy oref tn) <> Constraints.unspentOutputs utxos + tx = Constraints.mustForgeValue val <> Constraints.mustSpendPubKeyOutput oref + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + tell [toJSON ( unCurrencySymbol (curSymbol oref tn), convertString (unTokenName tn)::String)] + Contract.logInfo @String $ printf "forged %s" (show val) + pure $ toJSON (curSymbol oref tn,unTokenName tn ) \ No newline at end of file diff --git a/dquadrant/nft/src/Plutus/Contract/Blockchain/Param.hs b/dquadrant/nft/src/Plutus/Contract/Blockchain/Param.hs new file mode 100644 index 000000000..7c09d023d --- /dev/null +++ b/dquadrant/nft/src/Plutus/Contract/Blockchain/Param.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +-- | Implements a custom currency with a monetary policy that allows +-- the forging of a fixed amount of units. +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +module Plutus.Contract.Blockchain.Param +where + +import Control.Monad ( Monad((>>), (>>=)), void ) +import GHC.Generics (Generic) +import qualified Data.Map as Map +import Data.Text (Text) +import Data.Void (Void) +import Plutus.Contract as Contract hiding (when) +import Plutus.Trace.Emulator as Emulator +import qualified PlutusTx +import qualified PlutusTx.AssocMap as AssocMap +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import Ledger hiding (singleton,fee) +import qualified PlutusTx.Prelude as PlutusPrelude +import Ledger.Constraints as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value as Value +import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema, adaCurrency) +import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) +import Playground.Types (KnownCurrency (..)) +import qualified Prelude +import Prelude (Semigroup (..), Show (show), String) +import Text.Printf (printf) +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.UTF8 +import Data.Aeson (FromJSON, ToJSON, Value (Bool)) +import Ledger.Ada +import qualified Ledger.Ada as Ada +import Data.Semigroup (Last) +import PlutusTx.These +import qualified Data.ByteString as Builtins +import qualified Data.ByteString.UTF8 as U8 +import qualified Plutus.Contract as Extras + + + +data ByteParam =ByteParam + { + spCurrency :: !ByteString , + spToken :: !ByteString , + spCost :: !Integer + } deriving(GHC.Generics.Generic ,ToJSON,FromJSON,ToSchema) + diff --git a/dquadrant/nft/src/Plutus/Contract/Wallet/Utility.hs b/dquadrant/nft/src/Plutus/Contract/Wallet/Utility.hs new file mode 100644 index 000000000..de6148fa3 --- /dev/null +++ b/dquadrant/nft/src/Plutus/Contract/Wallet/Utility.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeFamilies #-} +module Plutus.Contract.Wallet.MarketPlace + +where +import Control.Lens +import PlutusTx.Prelude hiding (Monoid (..), Semigroup (..)) + +import Plutus.Contract as Contract + +import Ledger (CurrencySymbol, PubKeyHash, TxId, TxOutRef (..), pubKeyHash, + scriptCurrencySymbol, txId) +import qualified Ledger.Ada as Ada +import qualified Ledger.Constraints as Constraints +import qualified Ledger.Contexts as V +import Ledger.Scripts +import qualified PlutusTx + +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value (AssetClass, TokenName, Value) +import qualified Ledger.Value as Value + +import Data.Aeson (FromJSON, ToJSON) +import Data.Semigroup (Last (..)) +import GHC.Generics (Generic) +import qualified PlutusTx.AssocMap as AssocMap +import Prelude (Semigroup (..)) +import qualified Prelude +import Schema (ToSchema) +import Ledger.Contexts (ScriptContext (..), TxInfo (..)) + +ownFunds :: HasBlockchainActions s => Contract w s Text Value +ownFunds = do + pk <- ownPubKey + utxos <- utxoAt $ pubKeyAddress pk + let v = mconcat $ Map.elems $ txOutValue . txOutTxOut <$> utxos + logInfo @String $ "own funds: " ++ show (Value.flattenValue v) + return v + +ownFunds' :: Contract (Last Value) BlockchainActions Text () +ownFunds' = do + handleError logError $ ownFunds >>= tell . Last . Just + void $ Contract.waitNSlots 1 + ownFunds'