Merge pull request #46 from fullstack-development/protocol-script-ref

Protocol script ref in updateProtocol

src/Protocol/ProtocolScriptInfo.purs

@@ -4,7 +4,9 @@ import Contract.Prelude
 
 import Contract.Address (Address, getNetworkId, validatorHashBaseAddress)
 import Contract.Monad (Contract, liftContractM)
-import Contract.Transaction (TransactionInput, TransactionOutputWithRefScript)
+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)
@@ -13,7 +15,7 @@ import Info.AppInfo (getProtocolUtxo)
 import Protocol.Datum (PProtocolDatum)
 import Protocol.Models (Protocol)
 import Protocol.ProtocolScript (getProtocolValidatorHash, protocolValidatorScript)
-import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO)
+import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO, getUtxoByScriptRef)
 
 newtype ProtocolScriptInfo = ProtocolScriptInfo
   { pValidator :: Validator
@@ -23,6 +25,8 @@ newtype ProtocolScriptInfo = ProtocolScriptInfo
   , pUtxo :: (Tuple TransactionInput TransactionOutputWithRefScript)
   , pDatum :: PProtocolDatum
   , pValue :: Value.Value
+  , pScriptRef :: (Tuple TransactionInput TransactionOutputWithRefScript)
+  , pRefScriptInput :: InputWithScriptRef
   }
 
 getProtocolScriptInfo :: Protocol -> Contract ProtocolScriptInfo
@@ -36,6 +40,11 @@ getProtocolScriptInfo protocol = do
   protocolUtxo <- getProtocolUtxo protocol utxos
   currentDatum <- liftContractM "Impossible to get Protocol Datum" $ extractDatumFromUTxO protocolUtxo
   let value = extractValueFromUTxO protocolUtxo
+
+  let scriptRef = PlutusScriptRef (unwrap protocolValidator)
+  refScriptUtxo <- getUtxoByScriptRef "Protocol" scriptRef utxos
+  let refScriptInput = Constraints.RefInput $ mkTxUnspentOut (fst refScriptUtxo) (snd refScriptUtxo)
+
   pure $ ProtocolScriptInfo
     { pValidator: protocolValidator
     , pValidatorHash: protocolValidatorHash
@@ -44,4 +53,6 @@ getProtocolScriptInfo protocol = do
     , pUtxo: protocolUtxo
     , pDatum: currentDatum
     , pValue: value
+    , pScriptRef: refScriptUtxo
+    , pRefScriptInput: refScriptInput
     }

src/Protocol/StartProtocol.purs

@@ -5,10 +5,10 @@ import Contract.Prelude
 import Config.Protocol (mapFromProtocolData, writeProtocolConfig)
 import Contract.Address (getNetworkId, getWalletAddresses, getWalletAddressesWithNetworkTag, ownPaymentPubKeysHashes, addressToBech32, validatorHashBaseAddress)
 import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
-import Contract.Credential (Credential(ScriptCredential))
+import Contract.Credential (Credential(..))
 import Contract.Log (logInfo')
 import Contract.Monad (Contract, runContract, liftContractM, liftedM, liftedE)
-import Contract.PlutusData (Redeemer(Redeemer), Datum(Datum), toData)
+import Contract.PlutusData (Datum(Datum), Redeemer(Redeemer), toData)
 import Contract.ScriptLookups as Lookups
 import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
@@ -17,6 +17,7 @@ import Contract.Value as Value
 import Data.Array (head) as Array
 import Data.BigInt (fromInt)
 import Data.Map (toUnfoldable) as Map
+import Effect.Aff (launchAff_)
 import Ext.Contract.Value (mkCurrencySymbol)
 import MintingPolicy.NftMinting as NFT
 import MintingPolicy.NftRedeemer (PNftRedeemer(..))
@@ -27,7 +28,7 @@ import Protocol.UserData (ProtocolConfigParams(..), ProtocolData, protocolToData
 import Shared.Config (mapFromProtocolConfigParams, writeDonatPoolConfig)
 import Shared.KeyWalletConfig (testnetKeyWalletConfig)
 import Shared.Utxo (filterNonCollateral)
-import Effect.Aff (launchAff_)
+import Shared.ScriptRef (createRefScriptUtxo)
 
 initialProtocolConfigParams ∷ ProtocolConfigParams
 initialProtocolConfigParams = ProtocolConfigParams
@@ -55,13 +56,17 @@ contract params@(ProtocolConfigParams { minAmountParam, maxAmountParam, minDurat
   oref <-
     liftContractM "Utxo set is empty"
       (fst <$> Array.head (filterNonCollateral $ Map.toUnfoldable utxos))
+
   mp /\ cs <- mkCurrencySymbol (NFT.mintingPolicy oref)
   tn <- protocolTokenName
   let
     protocol = Protocol
       { protocolCurrency: cs
       , protocolTokenName: tn
       }
+  protocolValidatorHash <- getProtocolValidatorHash protocol
+  protocolValidator <- protocolValidatorScript protocol
+
   let
     initialProtocolDatum = PProtocolDatum
       { minAmount: minAmountParam
@@ -74,8 +79,6 @@ contract params@(ProtocolConfigParams { minAmountParam, maxAmountParam, minDurat
       }
     nftValue = Value.singleton cs tn one
     paymentToProtocol = Value.lovelaceValueOf (fromInt 2000000) <> nftValue
-  protocolValidatorHash <- getProtocolValidatorHash protocol
-  protocolValidator <- protocolValidatorScript protocol
 
   let
     constraints :: Constraints.TxConstraints Void Void
@@ -114,6 +117,8 @@ contract params@(ProtocolConfigParams { minAmountParam, maxAmountParam, minDurat
   bech32Address <- addressToBech32 protocolAddress
   logInfo' $ "Current protocol address: " <> show bech32Address
   logInfo' "Transaction submitted successfully"
+
+  createRefScriptUtxo "Protocol" protocolValidatorHash protocolValidator
   protocolData <- protocolToData protocol
 
   let protocolConfig = mapFromProtocolData protocolData

src/Protocol/UpdateProtocol.purs

@@ -40,6 +40,7 @@ contract protocolData protocolConfigParams = do
   logInfo' "Running update protocol"
   protocol <- dataToProtocol protocolData
   (ProtocolScriptInfo protocolInfo) <- getProtocolScriptInfo protocol
+
   ownHashes <- ownPaymentPubKeysHashes
   ownPkh <- liftContractM "Impossible to get own PaymentPubkeyHash" $ Array.head ownHashes
   ownAddress <- liftedM "Failed to get own address" $ Array.head <$> getWalletAddresses
@@ -58,19 +59,22 @@ contract protocolData protocolConfigParams = do
   let
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendScriptOutput (fst protocolInfo.pUtxo) updateProtocolRedeemer
+      Constraints.mustSpendScriptOutputUsingScriptRef
+        (fst protocolInfo.pUtxo)
+        updateProtocolRedeemer
+        protocolInfo.pRefScriptInput
         <> Constraints.mustPayToScriptAddress
           protocolInfo.pValidatorHash
           (ScriptCredential protocolInfo.pValidatorHash)
           newPDatum
           Constraints.DatumInline
           protocolInfo.pValue
+        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
         <> Constraints.mustBeSignedBy ownPkh
   let
     lookups :: Lookups.ScriptLookups Void
     lookups =
-      Lookups.validator protocolInfo.pValidator
-        <> Lookups.unspentOutputs protocolInfo.pUtxos
+      Lookups.unspentOutputs protocolInfo.pUtxos
         <> Lookups.unspentOutputs walletUtxo
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints

src/Shared/MinAda.purs

@@ -11,3 +11,4 @@ minAda = fromInt minAdaInt
 
 minAdaValue :: Value.Value
 minAdaValue = Value.lovelaceValueOf minAda
+

src/Shared/ScriptRef.purs

@@ -0,0 +1,51 @@
+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.PlutusData (PlutusData, unitDatum)
+import Contract.ScriptLookups as Lookups
+import Contract.Transaction (ScriptRef(..), awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
+import Contract.TxConstraints as Constraints
+import Ctl.Internal.Types.Scripts (Validator, ValidatorHash)
+import Data.Array (head) as Array
+import Shared.MinAda (minAdaValue)
+import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
+
+createRefScriptUtxo ∷ String -> ValidatorHash → Validator → Contract Unit
+createRefScriptUtxo scriptName validatorHash validator = do
+  logInfo' $ "Start to create " <> scriptName <> " reference script"
+  (OwnCredentials creds) <- getOwnCreds
+  let scriptRef = PlutusScriptRef (unwrap validator)
+
+  let
+    constraints :: Constraints.TxConstraints Unit Unit
+    constraints = Constraints.mustPayToScriptAddressWithScriptRef
+      validatorHash
+      (ScriptCredential validatorHash)
+      unitDatum
+      Constraints.DatumWitness
+      scriptRef
+      minAdaValue
+
+    lookups :: Lookups.ScriptLookups PlutusData
+    lookups = Lookups.unspentOutputs creds.ownUtxo
+
+  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
+  balancedTx <- liftedE $ balanceTxWithConstraints unbalancedTx balanceTxConstraints
+  balancedSignedTx <- signTransaction balancedTx
+  txId <- submit balancedSignedTx
+  awaitTxConfirmed txId
+  logInfo' $ scriptName <> " reference script created"

src/Shared/Utxo.purs

@@ -4,9 +4,9 @@ import Contract.Prelude
 
 import Contract.Monad (Contract, liftContractM)
 import Contract.PlutusData (Datum(..), fromData, class FromData)
-import Contract.Transaction (TransactionInput, TransactionOutputWithRefScript, OutputDatum(OutputDatum))
+import Contract.Transaction (OutputDatum(OutputDatum), ScriptRef, TransactionInput, TransactionOutputWithRefScript)
 import Contract.Value as Value
-import Ctl.Internal.Plutus.Types.Transaction (UtxoMap, _amount, _datum, _output)
+import Ctl.Internal.Plutus.Types.Transaction (UtxoMap, _amount, _datum, _output, _scriptRef)
 import Data.Array (filter, head) as Array
 import Data.BigInt (fromInt)
 import Data.Lens.Getter ((^.))
@@ -51,6 +51,19 @@ getUtxoByNFT scriptName nft utxos =
   liftContractM (scriptName <> " UTxO with given nft not found")
     (Array.head (filterByToken nft $ Map.toUnfoldable utxos))
 
+checkScriptRefInUTxO :: ScriptRef -> UtxoTuple -> Boolean
+checkScriptRefInUTxO scriptRef (Tuple _ txOutWithRef) =
+  txOutWithRef ^. _scriptRef == Just scriptRef
+
+filteByScriptRefInUtxo :: ScriptRef -> Array UtxoTuple -> Array UtxoTuple
+filteByScriptRefInUtxo scriptRef =
+  Array.filter (checkScriptRefInUTxO scriptRef)
+
+getUtxoByScriptRef :: String -> ScriptRef -> UtxoMap -> Contract UtxoTuple
+getUtxoByScriptRef scriptName scriptRef utxos =
+  liftContractM (scriptName <> " UTxO with script reference not found")
+    (Array.head (filteByScriptRefInUtxo scriptRef $ Map.toUnfoldable utxos))
+
 extractDatumFromUTxO
   :: forall (datum :: Type). FromData datum => UtxoTuple -> Maybe datum
 extractDatumFromUTxO (Tuple _ txOutWithRef) =