Merge pull request #51 from fullstack-development/MintingRefScripts

Minting ref scripts

src/Fundraising/Create.purs

@@ -10,6 +10,7 @@ import Contract.Log (logInfo')
 import Contract.Monad (Contract, liftContractM, liftedE)
 import Contract.PlutusData (Redeemer(Redeemer), Datum(Datum), toData)
 import Contract.ScriptLookups as Lookups
+import Contract.Scripts (MintingPolicyHash, mintingPolicyHash)
 import Contract.Time (POSIXTime(..))
 import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
@@ -65,6 +66,9 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
 
   verTokenMp /\ verTokenCs <- mkCurrencySymbol (VerToken.mintingPolicy protocol)
   verTn <- VerToken.verTokenName
+  let
+    verTokenPolicyHash :: MintingPolicyHash
+    verTokenPolicyHash = mintingPolicyHash verTokenMp
 
   let
     minAmount = view _minAmount protocolInfo.pDatum
@@ -130,13 +134,16 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PMintNft nftTn)
           nftValue
-        <> Constraints.mustMintValueWithRedeemer
+        <> Constraints.mustMintCurrencyWithRedeemerUsingScriptRef
+          verTokenPolicyHash
           (Redeemer $ toData $ PMintVerToken verTn)
-          verTokenValue
+          verTn
+          one
+          protocolInfo.references.verTokenInput
         <> Constraints.mustSpendScriptOutputUsingScriptRef
           (fst protocolInfo.pUtxo)
           protocolRedeemer
-          protocolInfo.pRefScriptInput
+          protocolInfo.references.pRefScriptInput
         <> Constraints.mustPayToScriptAddress
           protocolInfo.pValidatorHash
           (ScriptCredential protocolInfo.pValidatorHash)
@@ -150,12 +157,12 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
           Constraints.DatumInline
           paymentToFr
         <> Constraints.mustBeSignedBy creds.ownPkh
-        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
+        <> Constraints.mustReferenceOutput (fst protocolInfo.references.pScriptRef)
+        <> Constraints.mustReferenceOutput (fst protocolInfo.references.verTokenRef)
 
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy nftMp
-        <> Lookups.mintingPolicy verTokenMp
         <> Lookups.unspentOutputs creds.ownUtxos
         <> Lookups.unspentOutputs protocolInfo.pUtxos
 

src/Fundraising/ReceiveFunds.purs

@@ -11,6 +11,7 @@ import Contract.Log (logInfo')
 import Contract.Monad (Contract, liftedE, liftContractM)
 import Contract.PlutusData (Redeemer(Redeemer), toData)
 import Contract.ScriptLookups as Lookups
+import Contract.Scripts (MintingPolicyHash, mintingPolicyHash)
 import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
 import Contract.Value as Value
@@ -28,6 +29,8 @@ import Fundraising.UserData (FundraisingData(..))
 import MintingPolicy.NftMinting as NFT
 import MintingPolicy.NftRedeemer (PNftRedeemer(..))
 import MintingPolicy.VerTokenMinting as VerToken
+import MintingPolicy.VerTokenRedeemers (PVerTokenRedeemer(..))
+import Protocol.ProtocolScriptInfo (ProtocolScriptInfo(..), getProtocolScriptInfo)
 import Protocol.UserData (ProtocolData, dataToProtocol)
 import Shared.MinAda (minAda)
 import Shared.NetworkData (NetworkParams)
@@ -64,13 +67,17 @@ contract pData (FundraisingData fundraisingData) = do
 
   let receiveFundsRedeemer = toData >>> Redeemer $ PReceiveFunds threadTokenCurrency threadTokenName
 
-  let verTokenToBurnValue = Value.singleton fr.verTokenCurrency fr.verTokenName (fromInt (-1))
   let threadTokenToBurnValue = Value.singleton threadTokenCurrency threadTokenName (fromInt (-1))
   threadTokenMintingPolicy <- NFT.mintingPolicy currentDatum.tokenOrigin
   verTokenMintingPolicy <- VerToken.mintingPolicy protocol
   feeByFundraising <- liftContractM "Can't create BigInt after round" $ calcFee currentDatum.frFee donatedAmount
-  let amountToReceiver = Value.lovelaceValueOf $ (Value.valueOf currentFunds adaSymbol adaToken - feeByFundraising)
+  let
+    amountToReceiver = Value.lovelaceValueOf $ (Value.valueOf currentFunds adaSymbol adaToken - feeByFundraising)
+
+    verTokenPolicyHash :: MintingPolicyHash
+    verTokenPolicyHash = mintingPolicyHash verTokenMintingPolicy
 
+  (ProtocolScriptInfo protocolInfo) <- getProtocolScriptInfo protocol
   let
     constraints :: Constraints.TxConstraints Void Void
     constraints =
@@ -82,19 +89,22 @@ contract pData (FundraisingData fundraisingData) = do
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PBurnNft threadTokenName)
           threadTokenToBurnValue
-        <> Constraints.mustMintValueWithRedeemer
-          (Redeemer $ toData $ PBurnNft fr.verTokenName)
-          verTokenToBurnValue
+        <> Constraints.mustMintCurrencyWithRedeemerUsingScriptRef
+          verTokenPolicyHash
+          (Redeemer $ toData $ PBurnVerToken fr.verTokenName)
+          fr.verTokenName
+          (fromInt (-1))
+          protocolInfo.references.verTokenInput
         <> Constraints.mustPayToPubKeyAddress creds.ownPkh creds.ownSkh amountToReceiver
         <> Constraints.mustPayToPubKeyAddress managerPkh managerSkh (Value.lovelaceValueOf feeByFundraising)
         <> Constraints.mustValidateIn (from now)
         <> Constraints.mustReferenceOutput (fst frInfo.frScriptRef)
+        <> Constraints.mustReferenceOutput (fst protocolInfo.references.verTokenRef)
 
   let
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy threadTokenMintingPolicy
-        <> Lookups.mintingPolicy verTokenMintingPolicy
         <> Lookups.unspentOutputs frInfo.frUtxos
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints

src/Protocol/CloseProtocol.purs

@@ -50,7 +50,7 @@ contract protocolData = do
       Constraints.mustSpendScriptOutputUsingScriptRef
         (fst protocolInfo.pUtxo)
         protocolRedeemer
-        protocolInfo.pRefScriptInput
+        protocolInfo.references.pRefScriptInput
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PBurnNft protocolTokenName)
           nftToBurnValue
@@ -59,7 +59,7 @@ contract protocolData = do
           creds.ownSkh
           (Value.lovelaceValueOf (fromInt 2000000))
         <> Constraints.mustBeSignedBy creds.ownPkh
-        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
+        <> Constraints.mustReferenceOutput (fst protocolInfo.references.pScriptRef)
 
     lookups :: Lookups.ScriptLookups Void
     lookups =

src/Protocol/ProtocolScriptInfo.purs

@@ -4,29 +4,38 @@ import Contract.Prelude
 
 import Contract.Address (Address, getNetworkId, validatorHashBaseAddress)
 import Contract.Monad (Contract, liftContractM)
+import Contract.Scripts (MintingPolicy(..))
 import Contract.Transaction (ScriptRef(..), TransactionInput, TransactionOutputWithRefScript, mkTxUnspentOut)
 import Contract.TxConstraints (InputWithScriptRef)
 import Contract.TxConstraints as Constraints
 import Contract.Utxos (utxosAt)
 import Contract.Value as Value
 import Ctl.Internal.Types.Scripts (Validator, ValidatorHash)
 import Data.Map (Map)
+import Effect.Exception (throw)
 import Info.AppInfo (getProtocolUtxo)
+import MintingPolicy.VerTokenMinting as VerToken
 import Protocol.Datum (PProtocolDatum)
 import Protocol.Models (Protocol)
 import Protocol.ProtocolScript (getProtocolValidatorHash, protocolValidatorScript)
 import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO, getUtxoByScriptRef)
 
+type References =
+  { pScriptRef :: Tuple TransactionInput TransactionOutputWithRefScript
+  , pRefScriptInput :: InputWithScriptRef
+  , verTokenRef :: Tuple TransactionInput TransactionOutputWithRefScript
+  , verTokenInput :: InputWithScriptRef
+  }
+
 newtype ProtocolScriptInfo = ProtocolScriptInfo
   { pValidator :: Validator
   , pValidatorHash :: ValidatorHash
   , pAddress :: Address
   , pUtxos :: Map TransactionInput TransactionOutputWithRefScript
-  , pUtxo :: (Tuple TransactionInput TransactionOutputWithRefScript)
+  , pUtxo :: Tuple TransactionInput TransactionOutputWithRefScript
   , pDatum :: PProtocolDatum
   , pValue :: Value.Value
-  , pScriptRef :: (Tuple TransactionInput TransactionOutputWithRefScript)
-  , pRefScriptInput :: InputWithScriptRef
+  , references :: References
   }
 
 getProtocolScriptInfo :: Protocol -> Contract ProtocolScriptInfo
@@ -45,6 +54,20 @@ getProtocolScriptInfo protocol = do
   refScriptUtxo <- getUtxoByScriptRef "Protocol" scriptRef utxos
   let refScriptInput = Constraints.RefInput $ mkTxUnspentOut (fst refScriptUtxo) (snd refScriptUtxo)
 
+  managerUtxos <- utxosAt (unwrap currentDatum).managerAddress
+  verTokenMpWrapped <- VerToken.mintingPolicy protocol
+  policyRef <- case verTokenMpWrapped of
+    PlutusMintingPolicy policy -> pure $ PlutusScriptRef policy
+    _ -> liftEffect $ throw "Unexpected Minting Policy script type"
+  policyRefUtxo <- getUtxoByScriptRef "VerTokenPolicy" policyRef managerUtxos
+  let policyRefInput = Constraints.RefInput $ mkTxUnspentOut (fst policyRefUtxo) (snd policyRefUtxo)
+  let
+    refs =
+      { pScriptRef: refScriptUtxo
+      , pRefScriptInput: refScriptInput
+      , verTokenRef: policyRefUtxo
+      , verTokenInput: policyRefInput
+      }
   pure $ ProtocolScriptInfo
     { pValidator: protocolValidator
     , pValidatorHash: protocolValidatorHash
@@ -53,6 +76,5 @@ getProtocolScriptInfo protocol = do
     , pUtxo: protocolUtxo
     , pDatum: currentDatum
     , pValue: value
-    , pScriptRef: refScriptUtxo
-    , pRefScriptInput: refScriptInput
+    , references: refs
     }

src/Protocol/StartProtocol.purs

@@ -27,7 +27,7 @@ import Protocol.ProtocolScript (getProtocolValidatorHash, protocolTokenName, pro
 import Protocol.UserData (ProtocolConfigParams(..), ProtocolData, protocolToData)
 import Shared.Config (mapFromProtocolConfigParams, writeDonatPoolConfig)
 import Shared.KeyWalletConfig (testnetKeyWalletConfig)
-import Shared.ScriptRef (mkFundraisingRefScript, mkProtocolRefScript)
+import Shared.ScriptRef (mkFundraisingRefScript, mkProtocolRefScript, mkVerTokenPolicyRef)
 import Shared.Utxo (filterNonCollateral)
 
 initialProtocolConfigParams ∷ ProtocolConfigParams
@@ -48,6 +48,7 @@ startSystem params = do
   protocolData <- startProtocol params
   mkProtocolRefScript protocolData
   mkFundraisingRefScript protocolData
+  mkVerTokenPolicyRef protocolData
   pure protocolData
 
 startProtocol :: ProtocolConfigParams -> Contract ProtocolData

src/Protocol/UpdateProtocol.purs

@@ -63,14 +63,14 @@ contract protocolData protocolConfigParams = do
       Constraints.mustSpendScriptOutputUsingScriptRef
         (fst protocolInfo.pUtxo)
         updateProtocolRedeemer
-        protocolInfo.pRefScriptInput
+        protocolInfo.references.pRefScriptInput
         <> Constraints.mustPayToScriptAddress
           protocolInfo.pValidatorHash
           (ScriptCredential protocolInfo.pValidatorHash)
           newPDatum
           Constraints.DatumInline
           protocolInfo.pValue
-        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
+        <> Constraints.mustReferenceOutput (fst protocolInfo.references.pScriptRef)
         <> Constraints.mustBeSignedBy ownPkh
   let
     lookups :: Lookups.ScriptLookups Void

src/Shared/ScriptRef.purs

@@ -2,21 +2,21 @@ module Shared.ScriptRef where
 
 import Contract.Prelude
 
-import Contract.Address (getWalletAddressesWithNetworkTag)
 import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Credential (Credential(..))
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftedE, liftedM)
+import Contract.Monad (Contract, liftedE)
 import Contract.PlutusData (PlutusData, unitDatum)
 import Contract.ScriptLookups as Lookups
+import Contract.Scripts (MintingPolicy(..), Validator, ValidatorHash)
 import Contract.Transaction (ScriptRef(..), awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
 import Contract.Value as Value
-import Ctl.Internal.Types.Scripts (Validator, ValidatorHash)
-import Data.Array (head) as Array
 import Data.BigInt (fromInt)
+import Effect.Exception (throw)
 import Fundraising.FundraisingScript (fundraisingValidatorScript, getFundraisingValidatorHash)
 import Fundraising.FundraisingScriptInfo (makeFundraising)
+import MintingPolicy.VerTokenMinting as VerToken
 import Protocol.ProtocolScript (getProtocolValidatorHash, protocolValidatorScript)
 import Protocol.UserData (ProtocolData, dataToProtocol)
 import Shared.MinAda (minAda)
@@ -39,17 +39,13 @@ createRefScriptUtxo scriptName validatorHash validator = do
       sevenMinAdaValue
 
     lookups :: Lookups.ScriptLookups PlutusData
-    lookups = Lookups.unspentOutputs creds.ownUtxos
+    lookups = mempty
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
-  addressWithNetworkTag <-
-    liftedM "Failed to get own address with Network Tag"
-      $ Array.head
-      <$> getWalletAddressesWithNetworkTag
 
   let
     balanceTxConstraints :: BalanceTxConstraintsBuilder
-    balanceTxConstraints = mustSendChangeToAddress addressWithNetworkTag
+    balanceTxConstraints = mustSendChangeToAddress creds.ownAddressWithNetworkTag
   balancedTx <- liftedE $ balanceTxWithConstraints unbalancedTx balanceTxConstraints
   balancedSignedTx <- signTransaction balancedTx
   txId <- submit balancedSignedTx
@@ -71,3 +67,35 @@ mkFundraisingRefScript protocolData = do
   frValidator <- fundraisingValidatorScript fundraising
   frValidatorHash <- getFundraisingValidatorHash fundraising
   createRefScriptUtxo "Fundraising" frValidatorHash frValidator
+
+createPolicyRefUtxo :: String -> MintingPolicy → Contract Unit
+createPolicyRefUtxo _ (NativeMintingPolicy _) = liftEffect $ throw "Unexpected minting policy type"
+createPolicyRefUtxo mpName (PlutusMintingPolicy policy) = do
+  logInfo' $ "Creating UTxO with " <> mpName <> " minting policy name"
+  (OwnCredentials creds) <- getOwnCreds
+  let
+    scriptRef = PlutusScriptRef policy
+    sevenMinAdaValue = Value.lovelaceValueOf (minAda * (fromInt 7))
+
+    constraints :: Constraints.TxConstraints Unit Unit
+    constraints =
+      Constraints.mustPayToPubKeyAddressWithScriptRef creds.ownPkh creds.ownSkh scriptRef sevenMinAdaValue
+
+    lookups :: Lookups.ScriptLookups PlutusData
+    lookups = mempty
+
+  unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
+  let
+    balanceTxConstraints :: BalanceTxConstraintsBuilder
+    balanceTxConstraints = mustSendChangeToAddress creds.ownAddressWithNetworkTag
+  balancedTx <- liftedE $ balanceTxWithConstraints unbalancedTx balanceTxConstraints
+  balancedSignedTx <- signTransaction balancedTx
+  txId <- submit balancedSignedTx
+  awaitTxConfirmed txId
+  logInfo' $ "UTxO with " <> mpName <> " minting policy reference created"
+
+mkVerTokenPolicyRef :: ProtocolData -> Contract Unit
+mkVerTokenPolicyRef protocolData = do
+  protocol <- dataToProtocol protocolData
+  policy <- VerToken.mintingPolicy protocol
+  createPolicyRefUtxo "VerToken" policy