Catching onchain errors (#60)

* added tx error handling

* updated endpoints

* updated dists

src/Fundraising/Create.purs

@@ -3,16 +3,14 @@ module Fundraising.Create where
 import Contract.Prelude
 
 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, liftedE)
+import Contract.Monad (Contract, liftContractM)
 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
 import Contract.Value as Value
 import Ctl.Internal.Types.ByteArray (byteArrayFromAscii)
@@ -42,6 +40,7 @@ import Shared.MinAda (minAdaValue)
 import Shared.NetworkData (NetworkParams)
 import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 import Shared.RunContract (runContractWithResult)
+import Shared.Tx (completeTx)
 
 runCreateFundraising
   :: (FundraisingInfo -> Effect Unit)
@@ -58,7 +57,7 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
   logInfo' "Running Create Fundraising contract"
   protocol <- dataToProtocol protocolData
 
-  (OwnCredentials creds) <- getOwnCreds
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
   (ProtocolScriptInfo protocolInfo) <- getProtocolScriptInfo protocol
 
   nftMp /\ nftCs <- mkCurrencySymbol (NFT.mintingPolicy creds.nonCollateralORef)
@@ -166,15 +165,7 @@ contract protocolData (CreateFundraisingParams { title, amount, duration }) = do
         <> Lookups.unspentOutputs creds.ownUtxos
         <> Lookups.unspentOutputs protocolInfo.pUtxos
 
-  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
+  completeTx lookups constraints ownCreds
 
   logInfo' "Fundraising created successfully"
 

src/Fundraising/Donate.purs

@@ -2,14 +2,12 @@ module Fundraising.Donate where
 
 import Contract.Prelude
 
-import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Chain (currentTime)
 import Contract.Credential (Credential(ScriptCredential))
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftedE)
+import Contract.Monad (Contract)
 import Contract.PlutusData (Redeemer(Redeemer), toData)
 import Contract.ScriptLookups as Lookups
-import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
 import Contract.Value as Value
 import Ctl.Internal.Types.Datum (Datum(..))
@@ -20,14 +18,15 @@ import Ext.Contract.Value (mkCurrencySymbolFromString, runMkTokenName)
 import Fundraising.Datum (PFundraisingDatum(..))
 import Fundraising.FundraisingScriptInfo (FundraisingScriptInfo(..), getFundraisingScriptInfo, makeFundraising)
 import Fundraising.Models (Fundraising(..))
-import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 import Fundraising.Redeemer (PFundraisingRedeemer(..))
 import Fundraising.UserData (FundraisingData(..))
+import Protocol.UserData (ProtocolData)
 import Shared.Utxo (checkTokenInUTxO)
 import Shared.MinAda (minAdaValue)
 import Shared.NetworkData (NetworkParams)
+import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 import Shared.RunContract (runContractWithResult)
-import Protocol.UserData (ProtocolData)
+import Shared.Tx (completeTx)
 
 runDonate :: (Unit -> Effect Unit) -> (String -> Effect Unit) -> ProtocolData -> NetworkParams -> FundraisingData -> Int -> Effect Unit
 runDonate onComplete onError pData networkParams fundraisingData amount =
@@ -54,7 +53,7 @@ contract pData (FundraisingData fundraisingData) adaAmount = do
   when (now > deadline) $ throw >>> liftEffect $ "fundraising time is over"
   when (currentDonationsAmount >= amountToRaise) $ throw >>> liftEffect $ "fundraising goal is already completed"
 
-  (OwnCredentials creds) <- getOwnCreds
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
   let newDatum = Datum $ toData frInfo.frDatum
   let donation = Value.singleton Value.adaSymbol Value.adaToken amount
   let newValue = currentFunds <> donation
@@ -82,12 +81,6 @@ contract pData (FundraisingData fundraisingData) adaAmount = do
     lookups :: Lookups.ScriptLookups Void
     lookups = Lookups.unspentOutputs frInfo.frUtxos
 
-  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
+  completeTx lookups constraints ownCreds
+
   logInfo' "Donate finished successfully"

src/Fundraising/ReceiveFunds.purs

@@ -5,14 +5,12 @@ module Fundraising.ReceiveFunds
 
 import Contract.Prelude
 
-import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Chain (currentTime)
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftedE, liftContractM)
+import Contract.Monad (Contract, 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
 import Ctl.Internal.Plutus.Types.CurrencySymbol (adaSymbol)
@@ -37,6 +35,7 @@ import Shared.MinAda (minAda)
 import Shared.NetworkData (NetworkParams)
 import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds, getPkhSkhFromAddress)
 import Shared.RunContract (runContractWithResult)
+import Shared.Tx (completeTx)
 import Shared.Utxo (checkTokenInUTxO)
 
 runReceiveFunds :: (Unit -> Effect Unit) -> (String -> Effect Unit) -> ProtocolData -> NetworkParams -> FundraisingData -> Effect Unit
@@ -63,7 +62,7 @@ contract pData (FundraisingData fundraisingData) = do
     $ liftEffect
     $ throw "Can't receive funds while fundraising is in progress"
 
-  (OwnCredentials creds) <- getOwnCreds
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
   when (creds.ownPkh /= currentDatum.creatorPkh) $ liftEffect $ throw "Only fundraising creator can receive funds"
 
   let receiveFundsRedeemer = toData >>> Redeemer $ PReceiveFunds threadTokenCurrency threadTokenName
@@ -108,12 +107,6 @@ contract pData (FundraisingData fundraisingData) = do
       Lookups.mintingPolicy threadTokenMintingPolicy
         <> Lookups.unspentOutputs frInfo.frUtxos
 
-  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
+  completeTx lookups constraints ownCreds
+
   logInfo' "Receive funds finished successfully"

src/Protocol/CloseProtocol.purs

@@ -3,16 +3,12 @@ module Protocol.CloseProtocol where
 import Contract.Prelude
 
 import Config.Protocol (mapToProtocolData, readProtocolConfig)
-import Contract.Address (getWalletAddressesWithNetworkTag)
-import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftedE, liftedM, runContract)
+import Contract.Monad (Contract, runContract)
 import Contract.PlutusData (Redeemer(Redeemer), toData)
 import Contract.ScriptLookups as Lookups
-import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
 import Contract.Value as Value
-import Data.Array as Array
 import Data.BigInt (fromInt)
 import Effect.Aff (launchAff_)
 import Effect.Exception (throw)
@@ -24,6 +20,7 @@ import Protocol.Redeemer (PProtocolRedeemer(PCloseProtocol))
 import Protocol.UserData (ProtocolData, dataToProtocol)
 import Shared.KeyWalletConfig (testnetKeyWalletConfig)
 import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds, getPkhSkhFromAddress)
+import Shared.Tx (completeTx)
 
 runCloseProtocol :: Effect Unit
 runCloseProtocol = do
@@ -37,7 +34,7 @@ contract protocolData = do
   protocol@(Protocol { protocolCurrency, protocolTokenName }) <- dataToProtocol protocolData
   (ProtocolScriptInfo protocolInfo) <- getProtocolScriptInfo protocol
   managerPkh /\ _ <- getPkhSkhFromAddress (unwrap protocolInfo.pDatum).managerAddress
-  (OwnCredentials creds) <- getOwnCreds
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
   when (managerPkh /= creds.ownPkh) $ liftEffect $ throw "current user doesn't have permissions to close protocol"
   let nftOref = (unwrap protocolInfo.pDatum).tokenOriginRef
   mp <- NFT.mintingPolicy nftOref
@@ -66,14 +63,6 @@ contract protocolData = do
       Lookups.mintingPolicy mp
         <> 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
-  balancedTx <- liftedE $ balanceTxWithConstraints unbalancedTx balanceTxConstraints
-  balancedSignedTx <- signTransaction balancedTx
-  txId <- submit balancedSignedTx
-  awaitTxConfirmed txId
+  completeTx lookups constraints ownCreds
 
   logInfo' "closeProtocol finished successfully"

src/Protocol/StartProtocol.purs

@@ -3,20 +3,15 @@ module Protocol.StartProtocol where
 import Contract.Prelude
 
 import Config.Protocol (mapFromProtocolData, writeProtocolConfig)
-import Contract.Address (getNetworkId, getWalletAddresses, getWalletAddressesWithNetworkTag, ownPaymentPubKeysHashes, addressToBech32, validatorHashBaseAddress)
-import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
+import Contract.Address (addressToBech32, getNetworkId, validatorHashBaseAddress)
 import Contract.Credential (Credential(..))
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, runContract, liftContractM, liftedM, liftedE)
+import Contract.Monad (Contract, liftContractM, runContract)
 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
-import Contract.Utxos (utxosAt)
 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
@@ -27,8 +22,9 @@ import Protocol.ProtocolScript (getProtocolValidatorHash, protocolTokenName, pro
 import Protocol.UserData (ProtocolConfigParams(..), ProtocolData, protocolToData)
 import Shared.Config (mapFromProtocolConfigParams, writeDonatPoolConfig)
 import Shared.KeyWalletConfig (testnetKeyWalletConfig)
+import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds)
 import Shared.ScriptRef (mkFundraisingRefScript, mkProtocolRefScript, mkVerTokenPolicyRef)
-import Shared.Utxo (filterNonCollateral)
+import Shared.Tx (completeTx)
 
 initialProtocolConfigParams ∷ ProtocolConfigParams
 initialProtocolConfigParams = ProtocolConfigParams
@@ -54,19 +50,8 @@ startSystem params = do
 startProtocol :: ProtocolConfigParams -> Contract ProtocolData
 startProtocol params@(ProtocolConfigParams { minAmountParam, maxAmountParam, minDurationParam, maxDurationParam, protocolFeeParam }) = do
   logInfo' "Running startDonatPool protocol contract"
-  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
-  ownBech32Address <- addressToBech32 ownAddress
-  logInfo' $ "Own address is: " <> show ownBech32Address
-  utxos <- utxosAt ownAddress
-  logInfo' $ "UTxOs found on address: " <> show utxos
-  oref <-
-    liftContractM "Utxo set is empty"
-      (fst <$> Array.head (filterNonCollateral $ Map.toUnfoldable utxos))
-
-  mp /\ cs <- mkCurrencySymbol (NFT.mintingPolicy oref)
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
+  mp /\ cs <- mkCurrencySymbol (NFT.mintingPolicy creds.nonCollateralORef)
   tn <- protocolTokenName
   let
     protocol = Protocol
@@ -83,16 +68,16 @@ startProtocol params@(ProtocolConfigParams { minAmountParam, maxAmountParam, min
       , minDuration: minDurationParam
       , maxDuration: maxDurationParam
       , protocolFee: protocolFeeParam
-      , managerAddress: ownAddress
-      , tokenOriginRef: oref
+      , managerAddress: (unwrap creds.ownAddressWithNetworkTag).address
+      , tokenOriginRef: creds.nonCollateralORef
       }
     nftValue = Value.singleton cs tn one
     paymentToProtocol = Value.lovelaceValueOf (fromInt 2000000) <> nftValue
 
   let
     constraints :: Constraints.TxConstraints Void Void
     constraints =
-      Constraints.mustSpendPubKeyOutput oref
+      Constraints.mustSpendPubKeyOutput creds.nonCollateralORef
         <> Constraints.mustMintValueWithRedeemer
           (Redeemer $ toData $ PMintNft tn)
           nftValue
@@ -106,18 +91,10 @@ startProtocol params@(ProtocolConfigParams { minAmountParam, maxAmountParam, min
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.mintingPolicy mp
-        <> Lookups.unspentOutputs utxos
+        <> Lookups.unspentOutputs creds.ownUtxos
         <> Lookups.validator protocolValidator
 
-  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
+  completeTx lookups constraints ownCreds
 
   logInfo' $ "Current protocol: " <> show protocol
   networkId <- getNetworkId

src/Protocol/UpdateProtocol.purs

@@ -3,18 +3,13 @@ module Protocol.UpdateProtocol where
 import Contract.Prelude
 
 import Config.Protocol (mapToProtocolData, readProtocolConfig)
-import Contract.Address (getWalletAddressesWithNetworkTag, getWalletAddresses, ownPaymentPubKeysHashes)
-import Contract.BalanceTxConstraints (BalanceTxConstraintsBuilder, mustSendChangeToAddress)
 import Contract.Credential (Credential(ScriptCredential))
 import Contract.Log (logInfo')
-import Contract.Monad (Contract, liftContractM, liftedE, liftedM, runContract)
+import Contract.Monad (Contract, runContract)
 import Contract.PlutusData (Redeemer(Redeemer), toData)
 import Contract.ScriptLookups as Lookups
-import Contract.Transaction (awaitTxConfirmed, balanceTxWithConstraints, signTransaction, submit)
 import Contract.TxConstraints as Constraints
-import Contract.Utxos (utxosAt)
 import Ctl.Internal.Types.Datum (Datum(..))
-import Data.Array (head) as Array
 import Data.Lens (view)
 import Effect.Aff (launchAff_)
 import Effect.Exception (throw)
@@ -25,8 +20,8 @@ import Protocol.Redeemer (PProtocolRedeemer(..))
 import Protocol.UserData (ProtocolConfigParams, ProtocolData, dataToProtocol, getConfigFromProtocolDatum, mapToProtocolConfig)
 import Shared.Config (mapToProtocolConfigParams, readDonatPoolConfig)
 import Shared.KeyWalletConfig (testnetKeyWalletConfig)
-import Shared.OwnCredentials (getPkhSkhFromAddress)
-import Shared.Utxo (getNonCollateralUtxo)
+import Shared.OwnCredentials (OwnCredentials(..), getOwnCreds, getPkhSkhFromAddress)
+import Shared.Tx (completeTx)
 
 runUpdateProtocol :: Effect Unit
 runUpdateProtocol = do
@@ -41,14 +36,10 @@ 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
-  walletUtxo <- utxosAt ownAddress >>= getNonCollateralUtxo
+  ownCreds@(OwnCredentials creds) <- getOwnCreds
 
   manager /\ _ <- getPkhSkhFromAddress $ view _managerAddress protocolInfo.pDatum
-  when (manager /= ownPkh) $ liftEffect $ throw "Current user doesn't have permissions to update protocol"
+  when (manager /= creds.ownPkh) $ liftEffect $ throw "Current user doesn't have permissions to update protocol"
 
   let protocolConfig = mapToProtocolConfig protocolConfigParams
   let newDatum = makeDatum protocolInfo.pDatum protocolConfig
@@ -71,22 +62,14 @@ contract protocolData protocolConfigParams = do
           Constraints.DatumInline
           protocolInfo.pValue
         <> Constraints.mustReferenceOutput (fst protocolInfo.references.pScriptRef)
-        <> Constraints.mustBeSignedBy ownPkh
+        <> Constraints.mustBeSignedBy creds.ownPkh
   let
     lookups :: Lookups.ScriptLookups Void
     lookups =
       Lookups.unspentOutputs protocolInfo.pUtxos
-        <> Lookups.unspentOutputs walletUtxo
 
-  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
+  completeTx lookups constraints ownCreds
+
   pure $ getConfigFromProtocolDatum newDatum
 
 makeDatum ∷ PProtocolDatum -> PProtocolConfig → PProtocolDatum