attach verTokenRef to protocol (#59)

src/Protocol/ProtocolScriptInfo.purs

@@ -45,21 +45,20 @@ getProtocolScriptInfo protocol = do
   networkId <- getNetworkId
   protocolAddress <-
     liftContractM "Impossible to get Protocol script address" $ validatorHashBaseAddress networkId protocolValidatorHash
-  utxos <- utxosAt protocolAddress
-  protocolUtxo <- getProtocolUtxo protocol utxos
+  protocolUtxos <- utxosAt protocolAddress
+  protocolUtxo <- getProtocolUtxo protocol protocolUtxos
   currentDatum <- liftContractM "Impossible to get Protocol Datum" $ extractDatumFromUTxO protocolUtxo
   let value = extractValueFromUTxO protocolUtxo
 
   let scriptRef = PlutusScriptRef (unwrap protocolValidator)
-  refScriptUtxo <- getUtxoByScriptRef "Protocol" scriptRef utxos
+  refScriptUtxo <- getUtxoByScriptRef "Protocol" scriptRef protocolUtxos
   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
+  policyRefUtxo <- getUtxoByScriptRef "VerTokenPolicy" policyRef protocolUtxos
   let policyRefInput = Constraints.RefInput $ mkTxUnspentOut (fst policyRefUtxo) (snd policyRefUtxo)
   let
     refs =
@@ -72,7 +71,7 @@ getProtocolScriptInfo protocol = do
     { pValidator: protocolValidator
     , pValidatorHash: protocolValidatorHash
     , pAddress: protocolAddress
-    , pUtxos: utxos
+    , pUtxos: protocolUtxos
     , pUtxo: protocolUtxo
     , pDatum: currentDatum
     , pValue: value

src/Shared/MinAda.purs

@@ -2,6 +2,7 @@ module Shared.MinAda where
 
 import Contract.Value as Value
 import Data.BigInt (BigInt, fromInt)
+import Contract.Prelude
 
 minAdaInt :: Int
 minAdaInt = 2_000_000
@@ -12,3 +13,5 @@ minAda = fromInt minAdaInt
 minAdaValue :: Value.Value
 minAdaValue = Value.lovelaceValueOf minAda
 
+sevenMinAdaValue ∷ Value.Value
+sevenMinAdaValue = Value.lovelaceValueOf (minAda * (fromInt 7))

src/Shared/ScriptRef.purs

@@ -8,25 +8,23 @@ import Contract.Log (logInfo')
 import Contract.Monad (Contract, liftedE)
 import Contract.PlutusData (PlutusData, unitDatum)
 import Contract.ScriptLookups as Lookups
-import Contract.Scripts (MintingPolicy(..), Validator, ValidatorHash)
+import Contract.Scripts (MintingPolicy(..), ValidatorHash)
 import Contract.Transaction (ScriptRef(..), awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
-import Contract.Value as Value
-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)
+import Shared.MinAda (sevenMinAdaValue)
 import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 
-createRefScriptUtxo ∷ String -> ValidatorHash → Validator → Contract Unit
-createRefScriptUtxo scriptName validatorHash validator = do
+createRefScriptUtxo ∷ String -> ScriptRef -> ValidatorHash → Contract Unit
+createRefScriptUtxo _ (NativeScriptRef _) _ = liftEffect $ throw "Unexpected scriptRef type: waiting for PlutusScriptRef"
+createRefScriptUtxo scriptName scriptRef@(PlutusScriptRef _) validatorHash = do
   logInfo' $ "Start to create " <> scriptName <> " reference script"
   (OwnCredentials creds) <- getOwnCreds
-  let scriptRef = PlutusScriptRef (unwrap validator)
 
   let
     constraints :: Constraints.TxConstraints Unit Unit
@@ -51,51 +49,34 @@ createRefScriptUtxo scriptName validatorHash validator = do
   txId <- submit balancedSignedTx
   awaitTxConfirmed txId
   logInfo' $ scriptName <> " UTxO with reference script created"
-  where
-  sevenMinAdaValue = Value.lovelaceValueOf (minAda * (fromInt 7))
 
 mkProtocolRefScript :: ProtocolData -> Contract Unit
 mkProtocolRefScript protocolData = do
   protocol <- dataToProtocol protocolData
   protocolValidatorHash <- getProtocolValidatorHash protocol
   protocolValidator <- protocolValidatorScript protocol
-  createRefScriptUtxo "Protocol" protocolValidatorHash protocolValidator
+  let scriptRef = PlutusScriptRef (unwrap protocolValidator)
+  createRefScriptUtxo "Protocol" scriptRef protocolValidatorHash
 
 mkFundraisingRefScript :: ProtocolData -> Contract Unit
 mkFundraisingRefScript protocolData = do
   fundraising <- makeFundraising protocolData
   frValidator <- fundraisingValidatorScript fundraising
   frValidatorHash <- getFundraisingValidatorHash fundraising
-  createRefScriptUtxo "Fundraising" frValidatorHash frValidator
+  let scriptRef = PlutusScriptRef (unwrap frValidator)
+  createRefScriptUtxo "Fundraising" scriptRef frValidatorHash
 
-createPolicyRefUtxo :: String -> MintingPolicy → Contract Unit
-createPolicyRefUtxo _ (NativeMintingPolicy _) = liftEffect $ throw "Unexpected minting policy type"
-createPolicyRefUtxo mpName (PlutusMintingPolicy policy) = do
+createPolicyRefUtxo :: String -> MintingPolicy → ValidatorHash → Contract Unit
+createPolicyRefUtxo _ (NativeMintingPolicy _) _ = liftEffect $ throw "Unexpected minting policy type"
+createPolicyRefUtxo mpName (PlutusMintingPolicy policy) validatorHash = do
   logInfo' $ "Creating UTxO with " <> mpName <> " minting policy reference"
-  (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
+  let scriptRef = PlutusScriptRef policy
+  createRefScriptUtxo "VerTokenPolicy" scriptRef validatorHash
   logInfo' $ "UTxO with " <> mpName <> " minting policy reference created"
 
 mkVerTokenPolicyRef :: ProtocolData -> Contract Unit
 mkVerTokenPolicyRef protocolData = do
   protocol <- dataToProtocol protocolData
+  protocolValidatorHash <- getProtocolValidatorHash protocol
   policy <- VerToken.mintingPolicy protocol
-  createPolicyRefUtxo "VerToken" policy
+  createPolicyRefUtxo "VerToken" policy protocolValidatorHash

ui/index.tsx

@@ -9,7 +9,7 @@ const root = ReactDOM.createRoot(document.getElementById('root')!);
 const App = () => {
 
   const protocolData = {
-    protocolCurrency: "ace9cc6db6e7a2aafd05ca29363859b94a081e820f3a00d9c39420ff",
+    protocolCurrency: "620d42a0fd0a9454d82fa273bd09bbad8900f81be47efd359423b1f3",
     protocolTokenName: "DonatPoolProtocol"
   }