diff --git a/src/Protocol/ProtocolScriptInfo.purs b/src/Protocol/ProtocolScriptInfo.purs index b7b3e51..217a30c 100644 --- a/src/Protocol/ProtocolScriptInfo.purs +++ b/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 } diff --git a/src/Protocol/StartProtocol.purs b/src/Protocol/StartProtocol.purs index 9453cee..3e280d0 100644 --- a/src/Protocol/StartProtocol.purs +++ b/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,6 +56,7 @@ 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 @@ -62,6 +64,9 @@ contract params@(ProtocolConfigParams { minAmountParam, maxAmountParam, minDurat { 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 diff --git a/src/Protocol/UpdateProtocol.purs b/src/Protocol/UpdateProtocol.purs index 5cbfec0..3a51b09 100644 --- a/src/Protocol/UpdateProtocol.purs +++ b/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 diff --git a/src/Shared/MinAda.purs b/src/Shared/MinAda.purs index 6998e79..2377c52 100644 --- a/src/Shared/MinAda.purs +++ b/src/Shared/MinAda.purs @@ -11,3 +11,4 @@ minAda = fromInt minAdaInt minAdaValue :: Value.Value minAdaValue = Value.lovelaceValueOf minAda + diff --git a/src/Shared/ScriptRef.purs b/src/Shared/ScriptRef.purs new file mode 100644 index 0000000..69e1ef7 --- /dev/null +++ b/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" diff --git a/src/Shared/Utxo.purs b/src/Shared/Utxo.purs index 4a1eb8a..2c6990b 100644 --- a/src/Shared/Utxo.purs +++ b/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) =