|
| 1 | +{-# LANGUAGE RecordWildCards #-} |
1 | 2 | {-# LANGUAGE TemplateHaskell #-} |
2 | 3 |
|
3 | 4 | module Cardano.PlutusExample.NFT where |
4 | 5 |
|
5 | 6 | import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1) |
6 | 7 | import Codec.Serialise (serialise) |
7 | | -import Control.Monad hiding (fmap) |
| 8 | +import Control.Monad (void) |
| 9 | +import Data.Aeson.TH (defaultOptions, deriveJSON) |
8 | 10 | import Data.ByteString.Lazy qualified as LBS |
9 | 11 | import Data.ByteString.Short qualified as SBS |
10 | 12 | import Data.Map qualified as Map |
11 | 13 | import Data.Monoid (Last (Last)) |
12 | 14 | import Data.Text (Text) |
13 | 15 | import Data.Text qualified as Text |
14 | 16 | import Data.Void (Void) |
15 | | -import Ledger hiding (singleton) |
| 17 | +import Ledger ( |
| 18 | + CurrencySymbol, |
| 19 | + PaymentPubKeyHash, |
| 20 | + Script, |
| 21 | + ScriptContext (scriptContextTxInfo), |
| 22 | + TokenName, |
| 23 | + TxInInfo (txInInfoOutRef), |
| 24 | + TxInfo (txInfoInputs, txInfoMint), |
| 25 | + TxOutRef, |
| 26 | + mkMintingPolicyScript, |
| 27 | + ownCurrencySymbol, |
| 28 | + pubKeyHashAddress, |
| 29 | + scriptCurrencySymbol, |
| 30 | + ) |
| 31 | +import Ledger.Address (StakePubKeyHash) |
16 | 32 | import Ledger.Constraints as Constraints |
| 33 | +import Ledger.Constraints.Metadata ( |
| 34 | + NftMetadata (NftMetadata), |
| 35 | + NftMetadataToken (NftMetadataToken), |
| 36 | + TxMetadata (TxMetadata), |
| 37 | + nmtDescription, |
| 38 | + nmtFiles, |
| 39 | + nmtImage, |
| 40 | + nmtMediaType, |
| 41 | + nmtName, |
| 42 | + nmtOtherFields, |
| 43 | + ) |
17 | 44 | import Ledger.Typed.Scripts (wrapMintingPolicy) |
18 | | -import Ledger.Value as Value |
| 45 | +import Ledger.Value (flattenValue, singleton) |
19 | 46 | import Plutus.Contract (Contract, Endpoint, submitTxConstraintsWith, tell, utxosAt) |
20 | 47 | import Plutus.Contract qualified as Contract |
21 | 48 | import Plutus.V1.Ledger.Scripts qualified as Scripts |
22 | 49 | import PlutusTx qualified |
23 | | -import PlutusTx.Prelude hiding (Semigroup (..), unless) |
| 50 | +import PlutusTx.Prelude |
24 | 51 | import Text.Printf (printf) |
25 | | -import Prelude (Semigroup (..), String, show) |
| 52 | +import Prelude qualified as Hask |
26 | 53 |
|
27 | 54 | {-# INLINEABLE mkPolicy #-} |
28 | 55 | mkPolicy :: TxOutRef -> TokenName -> BuiltinData -> ScriptContext -> Bool |
@@ -63,18 +90,52 @@ curSymbol oref tn = scriptCurrencySymbol $ policy oref tn |
63 | 90 | type NFTSchema = |
64 | 91 | Endpoint "mint" TokenName |
65 | 92 |
|
66 | | -mintNft :: TokenName -> Contract (Last Text) NFTSchema Text () |
67 | | -mintNft tn = do |
| 93 | +data MintParams = MintParams |
| 94 | + { mpName :: Text |
| 95 | + , mpDescription :: Maybe Text |
| 96 | + , mpImage :: Text |
| 97 | + , mpTokenName :: TokenName |
| 98 | + , mpPubKeyHash :: PaymentPubKeyHash |
| 99 | + , mpStakeHash :: StakePubKeyHash |
| 100 | + } |
| 101 | + deriving stock (Hask.Show) |
| 102 | + |
| 103 | +$(deriveJSON defaultOptions ''MintParams) |
| 104 | + |
| 105 | +mintNft :: MintParams -> Contract (Last Text) NFTSchema Text () |
| 106 | +mintNft MintParams {..} = do |
68 | 107 | pkh <- Contract.ownPaymentPubKeyHash |
69 | 108 | utxos <- utxosAt (pubKeyHashAddress pkh Nothing) |
70 | | - tell $ Last $ Just "Contract started with " |
71 | 109 | case Map.keys utxos of |
72 | | - [] -> Contract.logError @String "no utxo found" |
| 110 | + [] -> Contract.logError @Hask.String "no utxo found" |
73 | 111 | oref : _ -> do |
74 | | - tell $ Last $ Just $ "Using oref:" <> Text.pack (show oref) |
75 | | - let val = Value.singleton (curSymbol oref tn) tn 1 |
76 | | - lookups = Constraints.mintingPolicy (policy oref tn) <> Constraints.unspentOutputs utxos |
77 | | - tx = Constraints.mustMintValue val <> Constraints.mustSpendPubKeyOutput oref |
| 112 | + tell $ Last $ Just $ "Using oref:" Hask.<> Text.pack (Hask.show oref) |
| 113 | + let cs = curSymbol oref mpTokenName |
| 114 | + val = singleton cs mpTokenName 1 |
| 115 | + meta = |
| 116 | + NftMetadata $ |
| 117 | + Map.singleton cs $ |
| 118 | + Map.singleton mpTokenName $ |
| 119 | + NftMetadataToken |
| 120 | + { nmtName = mpName |
| 121 | + , nmtImage = mpImage |
| 122 | + , nmtMediaType = Hask.pure "image/png" |
| 123 | + , nmtDescription = mpDescription |
| 124 | + , nmtFiles = Hask.mempty |
| 125 | + , nmtOtherFields = Hask.mempty |
| 126 | + } |
| 127 | + lookups = |
| 128 | + Hask.mconcat |
| 129 | + [ Constraints.mintingPolicy (policy oref mpTokenName) |
| 130 | + , Constraints.unspentOutputs utxos |
| 131 | + ] |
| 132 | + tx = |
| 133 | + Hask.mconcat |
| 134 | + [ Constraints.mustMintValue val |
| 135 | + , Constraints.mustSpendPubKeyOutput oref |
| 136 | + , Constraints.mustPayToPubKeyAddress mpPubKeyHash mpStakeHash val |
| 137 | + , Constraints.mustIncludeMetadata $ TxMetadata (Just meta) Hask.mempty |
| 138 | + ] |
78 | 139 | void $ submitTxConstraintsWith @Void lookups tx |
79 | | - Contract.logInfo @String $ printf "forged %s" (show val) |
| 140 | + Contract.logInfo @Hask.String $ printf "forged %s" (Hask.show val) |
80 | 141 | tell $ Last $ Just "Finished" |
0 commit comments