Auto-execute/withdraw uses reference scripts, if possible.

input-output-hk · Sep 24, 2022 · 5cf09c7 · 5cf09c7
1 parent 3709087
commit 5cf09c7
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 6 deletions.
diff --git a/marlowe-cli/marlowe-cli.cabal b/marlowe-cli/marlowe-cli.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.2
 name: marlowe-cli
-version: 0.0.8.2
+version: 0.0.8.3
 license: Apache-2.0
 license-files:
   LICENSE

diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Run.hs b/marlowe-cli/src/Language/Marlowe/CLI/Run.hs
@@ -68,6 +68,7 @@ import Cardano.Api
   , TxOutDatum(..)
   , UTxO(..)
   , getTxId
+  , hashScript
   , lovelaceToValue
   , txOutValueToValue
   , writeFileTextEnvelope
@@ -90,15 +91,24 @@ import Data.Traversable (for)
 import Data.Tuple.Extra (uncurry3)
 import Language.Marlowe.CLI.Cardano.Api (adjustMinimumUTxO)
 import Language.Marlowe.CLI.Cardano.Api.Address (toShelleyStakeReference)
-import Language.Marlowe.CLI.Cardano.Api.PlutusScript (IsPlutusScriptLanguage(plutusScriptVersion))
+import Language.Marlowe.CLI.Cardano.Api.PlutusScript as PS
 import Language.Marlowe.CLI.Export
   (buildMarloweDatum, buildRedeemer, buildRoleDatum, buildRoleRedeemer, marloweValidatorInfo, roleValidatorInfo)
 import Language.Marlowe.CLI.IO
   (decodeFileStrict, liftCli, liftCliIO, maybeWriteJson, queryInEra, readMaybeMetadata, readSigningKey)
 import Language.Marlowe.CLI.Merkle (merkleizeInputs, merkleizeMarlowe)
 import Language.Marlowe.CLI.Orphans ()
 import Language.Marlowe.CLI.Transaction
-  (buildBody, buildPayFromScript, buildPayToScript, ensureMinUtxo, hashSigningKey, makeTxOut', selectCoins, submitBody)
+  ( buildBody
+  , buildPayFromScript
+  , buildPayToScript
+  , ensureMinUtxo
+  , findScriptRef
+  , hashSigningKey
+  , makeTxOut'
+  , selectCoins
+  , submitBody
+  )
 import Language.Marlowe.CLI.Types
   ( CliEnv
   , CliError(..)
@@ -107,6 +117,7 @@ import Language.Marlowe.CLI.Types
   , MarloweScriptsRefs(MarloweScriptsRefs, mrMarloweValidator, mrRolePayoutValidator)
   , MarloweTransaction(..)
   , PrintStats(PrintStats)
+  , PublishingStrategy(..)
   , RedeemerInfo(..)
   , SigningKeyFile(..)
   , SomeMarloweTransaction(..)
@@ -147,6 +158,7 @@ import Language.Marlowe.Core.V1.Semantics.Types
   , getInputContent
   )
 import Language.Marlowe.Core.V1.Semantics.Types.Address (Network, mainnet, testnet)
+import Language.Marlowe.Scripts (marloweValidator, rolePayoutValidator)
 import Ledger.Tx.CardanoAPI (fromCardanoAddressInEra, toCardanoAddressInEra, toCardanoScriptDataHash, toCardanoValue)
 import Plutus.ApiCommon (ProtocolVersion)
 import Plutus.V1.Ledger.Ada (fromValue)
@@ -744,9 +756,17 @@ autoRunTransactionImpl connection marloweInBundle marloweOut' changeAddress sign
   do
     -- Fetch the protocol parameters.
     protocol <- queryInEra connection QueryProtocolParameters
-    -- Read the Marlowe transaction information for the output.
     -- Fetch the era.
     era <- askEra @era
+    -- Attempt to fetch the reference script.
+    marloweRef <-
+      withShelleyBasedEra era
+        $ findScriptRef
+            connection
+            (hashScript . PS.toScript $ fromV2TypedValidator marloweValidator)
+            (PublishPermanently NoStakeAddress)
+            (plutusScriptVersion :: PlutusScriptVersion lang)
+            (PrintStats False)
     let
       go :: MarloweTransaction lang era -> m (TxBody era)
       go marloweOut = do
@@ -765,7 +785,7 @@ autoRunTransactionImpl connection marloweInBundle marloweOut' changeAddress sign
                                             let
                                               -- Fetch the validator.
                                               validatorInfo = mtValidator marloweIn
-                                              validator = validatorInfoScriptOrReference validatorInfo
+                                              validator = validatorInfoScriptOrReference $ maybe validatorInfo snd marloweRef
                                               -- Build the redeemer.
                                               redeemer = riRedeemer $ buildRedeemer (mtInputs marloweOut)
                                               -- Build the datum.
@@ -1008,6 +1028,17 @@ autoWithdrawFundsImpl connection marloweOut roleName changeAddress signingKeys m
   do
     -- Fetch the protocol parameters.
     protocol <- queryInEra connection QueryProtocolParameters
+    -- Fetch the era.
+    era <- askEra @era
+    -- Attempt to fetch the reference script.
+    rolesRef <-
+      withShelleyBasedEra era
+        $ findScriptRef
+            connection
+            (hashScript . PS.toScript $ fromV2TypedValidator rolePayoutValidator)
+            (PublishPermanently NoStakeAddress)
+            (plutusScriptVersion :: PlutusScriptVersion lang)
+            (PrintStats False)
     let
       roleCurrency = mtRolesCurrency marloweOut
       -- Build the datum corresponding to the role name.
@@ -1018,7 +1049,7 @@ autoWithdrawFundsImpl connection marloweOut roleName changeAddress signingKeys m
       -- Compute the validator information.
       validatorInfo = mtRoleValidator marloweOut
       -- Fetch the role-payout validator script.
-      roleScript = validatorInfoScriptOrReference validatorInfo
+      roleScript = validatorInfoScriptOrReference $ maybe validatorInfo snd rolesRef
       -- Fetch the role address.
       roleAddress = viAddress validatorInfo
       -- Build the necessary redeemer.

diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs b/marlowe-cli/src/Language/Marlowe/CLI/Transaction.hs
@@ -47,6 +47,7 @@ module Language.Marlowe.CLI.Transaction
     -- * Quering
   , findMarloweScriptsRefs
   , findPublished
+  , findScriptRef
     -- * Low-Level Functions
   , buildBody
   , buildPayFromScript