Merge pull request #77 from mlabs-haskell/t4/metadata-2

Add metadata support

Author: nazrhom

bot-plutus-interface.cabal

@@ -97,6 +97,7 @@ library
     , cardano-api
     , cardano-crypto
     , cardano-ledger-alonzo
+    , cardano-prelude
     , cardano-slotting
     , containers
     , data-default
@@ -136,6 +137,7 @@ library
     , text                       ^>=1.2.4.0
     , transformers
     , transformers-either
+    , transformers-except
     , unordered-containers
     , uuid
     , wai

examples/plutus-game/app/Main.hs

@@ -69,6 +69,7 @@ main = do
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
           , pcEnableTxEndpoint = True
+          , pcMetadataDir = "./metadata"
           , pcCollectStats = False
           }
   BotPlutusInterface.runPAB @GameContracts pabConf

examples/plutus-nft/.gitignore

@@ -1,3 +1,4 @@
 scripts
 signing-keys
 txs
+metadata

examples/plutus-nft/app/Main.hs

@@ -13,16 +13,12 @@ import BotPlutusInterface.Types (
   endpointsToSchemas,
  )
 import Cardano.Api (NetworkId (Testnet), NetworkMagic (..))
-import Cardano.PlutusExample.NFT (
-  NFTSchema,
-  mintNft,
- )
+import Cardano.PlutusExample.NFT
 import Data.Aeson qualified as JSON
 import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.ByteString.Lazy qualified as LazyByteString
 import Data.Default (def)
 import Data.Maybe (fromMaybe)
-import Ledger.Value (TokenName)
 import Playground.Types (FunctionSchema)
 import Schema (FormSchema)
 import Servant.Client.Core (BaseUrl (BaseUrl), Scheme (Http))
@@ -37,11 +33,11 @@ instance HasDefinitions MintNFTContracts where
 
   getContract :: (MintNFTContracts -> SomeBuiltin)
   getContract = \case
-    MintNFT tokenName ->
+    MintNFT p ->
       SomeBuiltin $
-        mintNft tokenName
+        mintNft p
 
-newtype MintNFTContracts = MintNFT TokenName
+newtype MintNFTContracts = MintNFT MintParams
   deriving stock (Show)
 
 $(deriveJSON defaultOptions ''MintNFTContracts)
@@ -65,10 +61,11 @@ main = do
           , pcScriptFileDir = "./scripts"
           , pcSigningKeyFileDir = "./signing-keys"
           , pcTxFileDir = "./txs"
-          , pcDryRun = True
+          , pcDryRun = False
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
           , pcEnableTxEndpoint = True
+          , pcMetadataDir = "./metadata"
           , pcCollectStats = False
           }
   BotPlutusInterface.runPAB @MintNFTContracts pabConf

examples/plutus-nft/plutus-nft.cabal

@@ -76,10 +76,12 @@ library
   build-depends:
     , aeson                      ^>=1.5.0.0
     , attoparsec                 >=0.13.2.2
+    , base16-bytestring
     , bytestring                 ^>=0.10.12.0
     , cardano-api
     , cardano-crypto
     , cardano-ledger-alonzo
+    , cardano-prelude
     , containers
     , data-default
     , data-default-class
@@ -129,11 +131,13 @@ executable plutus-nft-pab
     , bot-plutus-interface
     , bytestring
     , cardano-api
+    , containers
     , data-default
     , playground-common
     , plutus-ledger
     , plutus-nft
     , servant-client-core
+    , text
 
   main-is:        Main.hs
   hs-source-dirs: app

examples/plutus-nft/src/Cardano/PlutusExample/NFT.hs

@@ -1,28 +1,55 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Cardano.PlutusExample.NFT where
 
 import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
 import Codec.Serialise (serialise)
-import Control.Monad hiding (fmap)
+import Control.Monad (void)
+import Data.Aeson.TH (defaultOptions, deriveJSON)
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
 import Data.Map qualified as Map
 import Data.Monoid (Last (Last))
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Void (Void)
-import Ledger hiding (singleton)
+import Ledger (
+  CurrencySymbol,
+  PaymentPubKeyHash,
+  Script,
+  ScriptContext (scriptContextTxInfo),
+  TokenName,
+  TxInInfo (txInInfoOutRef),
+  TxInfo (txInfoInputs, txInfoMint),
+  TxOutRef,
+  mkMintingPolicyScript,
+  ownCurrencySymbol,
+  pubKeyHashAddress,
+  scriptCurrencySymbol,
+ )
+import Ledger.Address (StakePubKeyHash)
 import Ledger.Constraints as Constraints
+import Ledger.Constraints.Metadata (
+  NftMetadata (NftMetadata),
+  NftMetadataToken (NftMetadataToken),
+  TxMetadata (TxMetadata),
+  nmtDescription,
+  nmtFiles,
+  nmtImage,
+  nmtMediaType,
+  nmtName,
+  nmtOtherFields,
+ )
 import Ledger.Typed.Scripts (wrapMintingPolicy)
-import Ledger.Value as Value
+import Ledger.Value (flattenValue, singleton)
 import Plutus.Contract (Contract, Endpoint, submitTxConstraintsWith, tell, utxosAt)
 import Plutus.Contract qualified as Contract
 import Plutus.V1.Ledger.Scripts qualified as Scripts
 import PlutusTx qualified
-import PlutusTx.Prelude hiding (Semigroup (..), unless)
+import PlutusTx.Prelude
 import Text.Printf (printf)
-import Prelude (Semigroup (..), String, show)
+import Prelude qualified as Hask
 
 {-# INLINEABLE mkPolicy #-}
 mkPolicy :: TxOutRef -> TokenName -> BuiltinData -> ScriptContext -> Bool
@@ -63,18 +90,52 @@ curSymbol oref tn = scriptCurrencySymbol $ policy oref tn
 type NFTSchema =
   Endpoint "mint" TokenName
 
-mintNft :: TokenName -> Contract (Last Text) NFTSchema Text ()
-mintNft tn = do
+data MintParams = MintParams
+  { mpName :: Text
+  , mpDescription :: Maybe Text
+  , mpImage :: Text
+  , mpTokenName :: TokenName
+  , mpPubKeyHash :: PaymentPubKeyHash
+  , mpStakeHash :: StakePubKeyHash
+  }
+  deriving stock (Hask.Show)
+
+$(deriveJSON defaultOptions ''MintParams)
+
+mintNft :: MintParams -> Contract (Last Text) NFTSchema Text ()
+mintNft MintParams {..} = do
   pkh <- Contract.ownPaymentPubKeyHash
   utxos <- utxosAt (pubKeyHashAddress pkh Nothing)
-  tell $ Last $ Just "Contract started with "
   case Map.keys utxos of
-    [] -> Contract.logError @String "no utxo found"
+    [] -> Contract.logError @Hask.String "no utxo found"
     oref : _ -> do
-      tell $ Last $ Just $ "Using oref:" <> Text.pack (show oref)
-      let val = Value.singleton (curSymbol oref tn) tn 1
-          lookups = Constraints.mintingPolicy (policy oref tn) <> Constraints.unspentOutputs utxos
-          tx = Constraints.mustMintValue val <> Constraints.mustSpendPubKeyOutput oref
+      tell $ Last $ Just $ "Using oref:" Hask.<> Text.pack (Hask.show oref)
+      let cs = curSymbol oref mpTokenName
+          val = singleton cs mpTokenName 1
+          meta =
+            NftMetadata $
+              Map.singleton cs $
+                Map.singleton mpTokenName $
+                  NftMetadataToken
+                    { nmtName = mpName
+                    , nmtImage = mpImage
+                    , nmtMediaType = Hask.pure "image/png"
+                    , nmtDescription = mpDescription
+                    , nmtFiles = Hask.mempty
+                    , nmtOtherFields = Hask.mempty
+                    }
+          lookups =
+            Hask.mconcat
+              [ Constraints.mintingPolicy (policy oref mpTokenName)
+              , Constraints.unspentOutputs utxos
+              ]
+          tx =
+            Hask.mconcat
+              [ Constraints.mustMintValue val
+              , Constraints.mustSpendPubKeyOutput oref
+              , Constraints.mustPayToPubKeyAddress mpPubKeyHash mpStakeHash val
+              , Constraints.mustIncludeMetadata $ TxMetadata (Just meta) Hask.mempty
+              ]
       void $ submitTxConstraintsWith @Void lookups tx
-      Contract.logInfo @String $ printf "forged %s" (show val)
+      Contract.logInfo @Hask.String $ printf "forged %s" (Hask.show val)
       tell $ Last $ Just "Finished"

examples/plutus-transfer/app/Main.hs

@@ -68,6 +68,7 @@ main = do
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
           , pcEnableTxEndpoint = True
+          , pcMetadataDir = "./metadata"
           , pcCollectStats = False
           }
   BotPlutusInterface.runPAB @TransferContracts pabConf

flake.lock

@@ -81,14 +81,17 @@
         "github:input-output-hk/ouroboros-network/d2d219a86cda42787325bb8c20539a75c2667132";
       flake = false;
     };
+    # Patched plutus for metadata support. We need this until `plutus-apps` will update `plutus`,
+    # rewrite of `plutus-ledger-constraints`, and possibly some bpi adjustments afterwards.
+    # tldr: Dependency hell
     plutus = {
       url =
-        "github:input-output-hk/plutus/cc72a56eafb02333c96f662581b57504f8f8992f";
+        "github:mlabs-haskell/plutus/1a3c3a761cf048371c52a34b004f8b3fcf0dab43";
       flake = false;
     };
     plutus-apps = {
       url =
-        "github:input-output-hk/plutus-apps/7f543e21d4945a2024e46c572303b9c1684a5832";
+        "github:mlabs-haskell/plutus-apps/82c0725c4d05398ae76d71927cc60aa23db1a11d";
       flake = false;
     };
     purescript-bridge = {

flake.nix

@@ -18,6 +18,7 @@ import BotPlutusInterface.Effects (PABEffect, ShellArgs (..), callCommand)
 import BotPlutusInterface.Files (
   DummyPrivKey (FromSKey, FromVKey),
   datumJsonFilePath,
+  metadataFilePath,
   policyScriptFilePath,
   redeemerJsonFilePath,
   signingKeyFilePath,
@@ -93,7 +94,7 @@ import Plutus.V1.Ledger.Api (
   ExMemory (..),
   TokenName (..),
  )
-import PlutusTx.Builtins (fromBuiltin)
+import PlutusTx.Builtins (BuiltinByteString, fromBuiltin)
 import Prelude
 
 -- | Getting information of the latest block
@@ -215,6 +216,7 @@ buildTx pabConf privKeys txBudget tx = do
         , txOutOpts pabConf (txData tx) (txOutputs tx)
         , mints
         , validRangeOpts (txValidRange tx)
+        , metadataOpts pabConf (txMetadata tx)
         , requiredSigners
         , ["--fee", showText . getLovelace . fromValue $ txFee tx]
         , mconcat
@@ -422,3 +424,8 @@ showText = Text.pack . show
 -- toWalletKey :: Wallet -> Text
 -- toWalletKey =
 --   decodeUtf8 . convertToBase Base16 . hash @ByteString @Blake2b_160 . unXPub . walletXPub
+
+metadataOpts :: PABConfig -> Maybe BuiltinByteString -> [Text]
+metadataOpts _ Nothing = mempty
+metadataOpts pabConf (Just meta) =
+  ["--metadata-json-file", metadataFilePath pabConf meta]