Fundraising ref script (#49)

* added NetworkParams to endpoints

* fixed testing endpoints

* updated dists

* minor fixes

* minor fixes

* added ref script utxo to create endpoint

* added ref scripts to donate endpoint

* added ref script to ReceiveFunds endpoint

* fixed getAllFundraisings

* added ref script to closeProtocol endpoint

* updated dists

* updated protocol currency

* commented broken tests

* use Nami

---------

Co-authored-by: Olga Klimenko <oklimenko92@mail.ru>

exe/StartProtocol.purs

@@ -3,7 +3,7 @@ module CLI.StartProtocol.Main where
 import Prelude
 
 import Effect (Effect)
-import Protocol.StartProtocol (runStartProtocol)
+import Protocol.StartProtocol (runStartSystem)
 
 main :: Effect Unit
-main = runStartProtocol
+main = runStartSystem

src/Fundraising/Create.purs

@@ -2,49 +2,45 @@ module Fundraising.Create where
 
 import Contract.Prelude
 
-import Contract.Address (getNetworkId, getWalletAddresses, ownPaymentPubKeysHashes, getWalletAddressesWithNetworkTag, validatorHashBaseAddress, addressToBech32)
+import Contract.Address (addressToBech32, getNetworkId, validatorHashBaseAddress)
 import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Chain (currentTime)
 import Contract.Credential (Credential(ScriptCredential))
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftContractM, liftedM, liftedE)
+import Contract.Monad (Contract, liftContractM, liftedE)
 import Contract.PlutusData (Redeemer(Redeemer), Datum(Datum), toData)
 import Contract.ScriptLookups as Lookups
 import Contract.Time (POSIXTime(..))
 import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
-import Contract.Utxos (utxosAt)
 import Contract.Value as Value
 import Ctl.Internal.Types.ByteArray (byteArrayFromAscii)
-import Data.Array (head) as Array
 import Data.BigInt (fromInt, toString)
 import Data.Lens (view)
-import Data.Map (toUnfoldable) as Map
 import Data.String (take)
 import Effect.Exception (throw)
 import Ext.Contract.Time (addTimes)
 import Ext.Contract.Value (currencySymbolToString, mkCurrencySymbol)
 import Ext.Seriaization.Key (pkhToBech32M)
 import Fundraising.Datum (PFundraisingDatum(..), titleLength)
-import Fundraising.FundraisingScript (getFundraisingTokenName, fundraisingValidatorScript, getFundraisingValidatorHash)
+import Fundraising.FundraisingScript (getFundraisingTokenName, getFundraisingValidatorHash)
 import Fundraising.Models (Fundraising(..))
 import Fundraising.UserData (CreateFundraisingParams(..))
-import Info.AppInfo (getProtocolUtxo)
 import Info.UserData (FundraisingInfo(..))
 import MintingPolicy.NftMinting as NFT
 import MintingPolicy.NftRedeemer (PNftRedeemer(..))
 import MintingPolicy.VerTokenMinting as VerToken
 import MintingPolicy.VerTokenRedeemers (PVerTokenRedeemer(..))
 import Protocol.Datum (_protocolFee, _minDuration, _maxDuration, _minAmount, _maxAmount, _managerPkh)
 import Protocol.Models (PFundriseConfig(..))
-import Protocol.ProtocolScript (getProtocolValidatorHash, protocolValidatorScript)
+import Protocol.ProtocolScriptInfo (ProtocolScriptInfo(..), getProtocolScriptInfo)
 import Protocol.Redeemer (PProtocolRedeemer(..))
 import Protocol.UserData (ProtocolData, dataToProtocol)
 import Shared.Duration (durationToMinutes, minutesToPosixTime)
 import Shared.MinAda (minAdaValue)
 import Shared.NetworkData (NetworkParams)
+import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 import Shared.RunContract (runContractWithResult)
-import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO, filterNonCollateral)
 
 runCreateFundraising
   :: (FundraisingInfo -> Effect Unit)
@@ -59,53 +55,28 @@ runCreateFundraising onComplete onError protocolData networkParams funraisingPar
 contract :: ProtocolData -> CreateFundraisingParams -> Contract FundraisingInfo
 contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
   logInfo' "Running Create Fundraising contract"
-  givenProtocol <- dataToProtocol protocolData
-  ownHashes <- ownPaymentPubKeysHashes
-  ownPkh <- liftContractM "Impossible to get own PaymentPubkeyHash" $ Array.head ownHashes
-  logInfo' $ "Own Payment pkh is: " <> show ownPkh
-
-  ownAddress <- liftedM "Failed to get own address" $ Array.head <$> getWalletAddresses
-  logInfo' $ "Own address is: " <> show ownAddress
-  ownUtxos <- utxosAt ownAddress
-  logInfo' $ "UTxOs found on address: " <> show ownUtxos
-  oref <-
-    liftContractM "Utxo set is empty"
-      (fst <$> Array.head (filterNonCollateral $ Map.toUnfoldable ownUtxos))
-  logInfo' $ "Desired user UTxO is: " <> show oref
-  nftMp /\ nftCs <- mkCurrencySymbol (NFT.mintingPolicy oref)
-  logInfo' $ "NFT currency symbol: " <> show nftCs
+  protocol <- dataToProtocol protocolData
+
+  (OwnCredentials creds) <- getOwnCreds
+  (ProtocolScriptInfo protocolInfo) <- getProtocolScriptInfo protocol
+
+  nftMp /\ nftCs <- mkCurrencySymbol (NFT.mintingPolicy creds.nonCollateralORef)
   nftTn <- getFundraisingTokenName
-  logInfo' $ "NFT token name: " <> show nftTn
 
-  verTokenMp /\ verTokenCs <- mkCurrencySymbol (VerToken.mintingPolicy givenProtocol)
-  logInfo' $ "VerToken currency symbol: " <> show verTokenCs
+  verTokenMp /\ verTokenCs <- mkCurrencySymbol (VerToken.mintingPolicy protocol)
   verTn <- VerToken.verTokenName
-  logInfo' $ "Ver token name: " <> show verTn
-
-  protocolValidator <- protocolValidatorScript givenProtocol
-  protocolValidatorHash <- getProtocolValidatorHash givenProtocol
-  networkId <- getNetworkId
-  protocolAddress <-
-    liftContractM "Impossible to get Protocol script address" $ validatorHashBaseAddress networkId protocolValidatorHash
-  logInfo' $ "Protocol validator address: " <> show protocolAddress
-  protocolUtxos <- utxosAt protocolAddress
-  logInfo' $ "Protocol UTxOs list: " <> show protocolUtxos
-  protocolUtxo <- getProtocolUtxo givenProtocol protocolUtxos
-  logInfo' $ "Desired protocol UTxO: " <> show protocolUtxo
-  protocolDatum <- liftContractM "Impossible to get Protocol Datum" $ extractDatumFromUTxO protocolUtxo
-  logInfo' $ "Protocol Datum: " <> show protocolDatum
 
   let
-    minAmount = view _minAmount protocolDatum
-    maxAmount = view _maxAmount protocolDatum
+    minAmount = view _minAmount protocolInfo.pDatum
+    maxAmount = view _maxAmount protocolInfo.pDatum
     targetAmount = fromInt amount * fromInt 1_000_000
 
   when (targetAmount < minAmount) $ liftEffect $ throw ("Fundraising amount too small. It must be greater than " <> toString minAmount <> ".")
   when (targetAmount > maxAmount) $ liftEffect $ throw ("Fundraising amount too big. It must be less than " <> toString maxAmount <> ".")
 
   let
-    minDurationMinutes = view _minDuration protocolDatum
-    maxDurationMinutes = view _maxDuration protocolDatum
+    minDurationMinutes = view _minDuration protocolInfo.pDatum
+    maxDurationMinutes = view _maxDuration protocolInfo.pDatum
     frDurationMinutes = durationToMinutes duration
 
   when (frDurationMinutes < minDurationMinutes) $ liftEffect $ throw ("Fundraising duration too short. It must be greater than " <> toString minDurationMinutes <> ".")
@@ -117,25 +88,23 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
 
   let
     initialFrDatum = PFundraisingDatum
-      { creatorPkh: ownPkh
-      , tokenOrigin: oref
+      { creatorPkh: creds.ownPkh
+      , tokenOrigin: creds.nonCollateralORef
       , frTitle: serializedTitle
       , frAmount: targetAmount
       , frDeadline: deadline
-      , frFee: view _protocolFee protocolDatum
-      , managerPkh: view _managerPkh protocolDatum
+      , frFee: view _protocolFee protocolInfo.pDatum
+      , managerPkh: view _managerPkh protocolInfo.pDatum
       }
 
   let
     fundraising = Fundraising
-      { protocol: givenProtocol
+      { protocol: protocol
       , verTokenCurrency: verTokenCs
       , verTokenName: verTn
       }
-
-  frValidator <- fundraisingValidatorScript fundraising
+  networkId <- getNetworkId
   frValidatorHash <- getFundraisingValidatorHash fundraising
-
   frAddress <- liftContractM "Impossible to get Fundraising script address" $ validatorHashBaseAddress networkId frValidatorHash
 
   let
@@ -153,49 +122,47 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
   let
     nftValue = Value.singleton nftCs nftTn one
     verTokenValue = Value.singleton verTokenCs verTn one
-    paymentToProtocol = extractValueFromUTxO protocolUtxo
     paymentToFr = minAdaValue <> minAdaValue <> nftValue <> verTokenValue
 
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendPubKeyOutput oref
+      Constraints.mustSpendPubKeyOutput creds.nonCollateralORef
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PMintNft nftTn)
           nftValue
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PMintVerToken verTn)
           verTokenValue
-        <> Constraints.mustSpendScriptOutput
-          (fst protocolUtxo)
+        <> Constraints.mustSpendScriptOutputUsingScriptRef
+          (fst protocolInfo.pUtxo)
           protocolRedeemer
+          protocolInfo.pRefScriptInput
         <> Constraints.mustPayToScriptAddress
-          protocolValidatorHash
-          (ScriptCredential protocolValidatorHash)
-          (Datum $ toData protocolDatum)
+          protocolInfo.pValidatorHash
+          (ScriptCredential protocolInfo.pValidatorHash)
+          (Datum $ toData protocolInfo.pDatum)
           Constraints.DatumInline
-          paymentToProtocol
+          protocolInfo.pValue
         <> Constraints.mustPayToScriptAddress
           frValidatorHash
           (ScriptCredential frValidatorHash)
           (Datum $ toData initialFrDatum)
           Constraints.DatumInline
           paymentToFr
-        <> Constraints.mustBeSignedBy ownPkh
+        <> Constraints.mustBeSignedBy creds.ownPkh
+        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
 
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy nftMp
         <> Lookups.mintingPolicy verTokenMp
-        <> Lookups.unspentOutputs ownUtxos
-        <> Lookups.unspentOutputs protocolUtxos
-        <> Lookups.validator protocolValidator
-        <> Lookups.validator frValidator
+        <> Lookups.unspentOutputs creds.ownUtxos
+        <> Lookups.unspentOutputs protocolInfo.pUtxos
 
   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
@@ -204,12 +171,10 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
 
   logInfo' "Fundraising created successfully"
 
-  logInfo' $ "Current fundraising: " <> show fundraising
-
   bech32Address <- addressToBech32 frAddress
   logInfo' $ "Current fundraising address: " <> show bech32Address
 
-  creatorPkh <- pkhToBech32M ownPkh
+  creatorPkh <- pkhToBech32M creds.ownPkh
   pure $ FundraisingInfo
     { creator: creatorPkh
     , title: title

src/Fundraising/Donate.purs

@@ -64,17 +64,23 @@ contract pData (FundraisingData fundraisingData) adaAmount = do
   let
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendScriptOutput (fst frInfo.frUtxo) donateRedeemer
-        <> Constraints.mustPayToScriptAddress frInfo.frValidatorHash (ScriptCredential frInfo.frValidatorHash) newDatum Constraints.DatumInline newValue
+      Constraints.mustSpendScriptOutputUsingScriptRef
+        (fst frInfo.frUtxo)
+        donateRedeemer
+        frInfo.frRefScriptInput
+        <> Constraints.mustPayToScriptAddress
+          frInfo.frValidatorHash
+          (ScriptCredential frInfo.frValidatorHash)
+          newDatum
+          Constraints.DatumInline
+          newValue
         <> Constraints.mustBeSignedBy creds.ownPkh
         <> Constraints.mustValidateIn donationTimeRange
+        <> Constraints.mustReferenceOutput (fst frInfo.frScriptRef)
 
   let
     lookups :: Lookups.ScriptLookups Void
-    lookups =
-      Lookups.validator frInfo.frValidator
-        <> Lookups.unspentOutputs frInfo.frUtxos
-        <> Lookups.unspentOutputs creds.ownUtxo
+    lookups = Lookups.unspentOutputs frInfo.frUtxos
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
   let

src/Fundraising/FundraisingScriptInfo.purs

@@ -5,7 +5,8 @@ import Contract.Prelude
 import Contract.Address (Address, validatorHashBaseAddress)
 import Contract.Config (NetworkId(TestnetId))
 import Contract.Monad (Contract, liftContractM)
-import Contract.Transaction (TransactionInput, TransactionOutputWithRefScript)
+import Contract.Transaction (ScriptRef(..), TransactionInput, TransactionOutputWithRefScript, mkTxUnspentOut)
+import Contract.TxConstraints as Constraints
 import Contract.Utxos (utxosAt)
 import Contract.Value as Value
 import Ctl.Internal.Types.Scripts (Validator, ValidatorHash)
@@ -15,7 +16,7 @@ import Fundraising.FundraisingScript (fundraisingValidatorScript, getFundraising
 import Fundraising.Models (Fundraising(..))
 import MintingPolicy.VerTokenMinting as VerToken
 import Protocol.UserData (ProtocolData, dataToProtocol)
-import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO, getUtxoByNFT)
+import Shared.Utxo (extractDatumFromUTxO, extractValueFromUTxO, getUtxoByNFT, getUtxoByScriptRef)
 import Ext.Contract.Value (mkCurrencySymbol)
 
 makeFundraising :: ProtocolData -> Contract Fundraising
@@ -37,6 +38,8 @@ newtype FundraisingScriptInfo = FundraisingScriptInfo
   , frUtxo :: (Tuple TransactionInput TransactionOutputWithRefScript)
   , frDatum :: PFundraisingDatum
   , frValue :: Value.Value
+  , frScriptRef :: (Tuple TransactionInput TransactionOutputWithRefScript)
+  , frRefScriptInput :: Constraints.InputWithScriptRef
   }
 
 getFundraisingScriptInfo :: Fundraising -> Value.CurrencySymbol -> Value.TokenName -> Contract FundraisingScriptInfo
@@ -48,6 +51,10 @@ getFundraisingScriptInfo fr threadTokenCurrency threadTokenName = do
   frUtxo <- getUtxoByNFT "Fundraising" (threadTokenCurrency /\ threadTokenName) frUtxos
   frDatum <- liftContractM "Impossible to get Fundraising Datum" $ extractDatumFromUTxO frUtxo
   let frFunds = extractValueFromUTxO frUtxo
+
+  let scriptRef = PlutusScriptRef (unwrap frValidator)
+  refScriptUtxo <- getUtxoByScriptRef "Fundraising" scriptRef frUtxos
+  let refScriptInput = Constraints.RefInput $ mkTxUnspentOut (fst refScriptUtxo) (snd refScriptUtxo)
   pure $ FundraisingScriptInfo
     { frValidator: frValidator
     , frValidatorHash: frValidatorHash
@@ -56,4 +63,6 @@ getFundraisingScriptInfo fr threadTokenCurrency threadTokenName = do
     , frUtxo: frUtxo
     , frDatum: frDatum
     , frValue: frFunds
+    , frScriptRef: refScriptUtxo
+    , frRefScriptInput: refScriptInput
     }

src/Fundraising/ReceiveFunds.purs

@@ -75,9 +75,10 @@ contract pData (FundraisingData fundraisingData) = do
   let
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendScriptOutput
+      Constraints.mustSpendScriptOutputUsingScriptRef
         (fst frInfo.frUtxo)
         receiveFundsRedeemer
+        frInfo.frRefScriptInput
         <> Constraints.mustBeSignedBy currentDatum.creatorPkh
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PBurnNft threadTokenName)
@@ -88,15 +89,14 @@ contract pData (FundraisingData fundraisingData) = do
         <> Constraints.mustPayToPubKeyAddress creds.ownPkh creds.ownSkh amountToReceiver
         <> Constraints.mustPayToPubKey managerPkh (Value.lovelaceValueOf feeByFundraising)
         <> Constraints.mustValidateIn (from now)
+        <> Constraints.mustReferenceOutput (fst frInfo.frScriptRef)
 
   let
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy threadTokenMintingPolicy
         <> Lookups.mintingPolicy verTokenMintingPolicy
-        <> Lookups.validator frInfo.frValidator
         <> Lookups.unspentOutputs frInfo.frUtxos
-        <> Lookups.unspentOutputs creds.ownUtxo
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
   let

src/Info/AllFundraisings.purs

@@ -17,6 +17,7 @@ import MintingPolicy.VerTokenMinting as VerToken
 import Protocol.UserData (ProtocolData, dataToProtocol)
 import Shared.NetworkData (NetworkParams)
 import Shared.RunContract (runContractWithResult)
+import Shared.Utxo (filterByToken)
 
 runGetAllFundraisings :: (Array FundraisingInfo -> Effect Unit) -> (String -> Effect Unit) -> ProtocolData -> NetworkParams -> Effect Unit
 runGetAllFundraisings onComplete onError protocolData networkParams =
@@ -39,6 +40,6 @@ getAllFundraisings protocolData = do
   frAddress <- liftContractM "Impossible to get Fundraising script address" $ validatorHashBaseAddress TestnetId frValidatorHash
 
   fundraisings <- utxosAt frAddress
-  frInfos <- traverse mapToFundraisingInfo (Map.toUnfoldable fundraisings)
+  frInfos <- traverse mapToFundraisingInfo <<< filterByToken (verTokenCs /\ verTn) $ Map.toUnfoldable fundraisings
   logInfo' $ "Found UTxOs" <> show frInfos
   pure frInfos

src/Protocol/CloseProtocol.purs

@@ -47,9 +47,10 @@ contract protocolData = do
 
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendScriptOutput
+      Constraints.mustSpendScriptOutputUsingScriptRef
         (fst protocolInfo.pUtxo)
         protocolRedeemer
+        protocolInfo.pRefScriptInput
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PBurnNft protocolTokenName)
           nftToBurnValue
@@ -58,13 +59,12 @@ contract protocolData = do
           creds.ownSkh
           (Value.lovelaceValueOf (fromInt 2000000))
         <> Constraints.mustBeSignedBy creds.ownPkh
+        <> Constraints.mustReferenceOutput (fst protocolInfo.pScriptRef)
 
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy mp
         <> Lookups.unspentOutputs protocolInfo.pUtxos
-        <> Lookups.unspentOutputs creds.ownUtxo
-        <> Lookups.validator protocolInfo.pValidator
 
   unbalancedTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
   addressWithNetworkTag <- liftedM "Failed to get own address with Network Tag" $ Array.head <$> getWalletAddressesWithNetworkTag