Merge branch 'main' into SCP-4446

marlowe-cli/examples/swap/run-swap.sh

@@ -346,42 +346,56 @@ cardano-cli query utxo --testnet-magic "$MAGIC" --address "$PARTY_B_ADDRESS" | s
 
 echo "## Clean Up"
 
-BURN_ADDRESS=addr_test1vqxdw4rlu6krp9fwgwcnld6y84wdahg585vrdy67n5urp9qyts0y7
+echo "Burning tokens issued by PARTY_A:"
 
-TX_CLEANUP_TOKEN_B=$(
-marlowe-cli util select --testnet-magic "$MAGIC"                   \
-                        --socket-path "$CARDANO_NODE_SOCKET_PATH"  \
-                        --asset-only "$TOKEN_B" "$PARTY_A_ADDRESS" \
-| sed -e 's/^TxIn "\(.*\)" (TxIx \(.*\))$/\1#\2/'                  \
-)
+marlowe-cli -- util burn --testnet-magic "$MAGIC" \
+                         --socket-path "$CARDANO_NODE_SOCKET_PATH" \
+                         --issuer "$PARTY_A_ADDRESS:$PARTY_A_PAYMENT_SKEY" \
+                         --expires $MINT_EXPIRES \
+                         --token-provider "$PARTY_A_ADDRESS:$PARTY_A_PAYMENT_SKEY" \
+                         --token-provider "$PARTY_B_ADDRESS:$PARTY_B_PAYMENT_SKEY" \
+                         --submit 600 \
+                         --out-file /dev/null
 
-marlowe-cli transaction simple --testnet-magic "$MAGIC"                            \
-                               --socket-path "$CARDANO_NODE_SOCKET_PATH"           \
-                               --tx-in "$TX_2"#0                                   \
-                               --tx-in "$TX_CLEANUP_TOKEN_B"                       \
-                               --tx-out "$BURN_ADDRESS+1500000+$AMOUNT_B $TOKEN_B" \
-                               --required-signer "$PARTY_A_PAYMENT_SKEY"           \
-                               --change-address "$FAUCET_ADDRESS"                  \
-                               --out-file /dev/null                                \
-                               --submit 600
+echo "Burning tokens issued by PARTY_B:"
 
-cardano-cli query utxo --testnet-magic "$MAGIC" --address "$PARTY_A_ADDRESS"
+marlowe-cli util burn --testnet-magic "$MAGIC" \
+                      --socket-path "$CARDANO_NODE_SOCKET_PATH" \
+                      --issuer "$PARTY_B_ADDRESS:$PARTY_B_PAYMENT_SKEY" \
+                      --expires $MINT_EXPIRES \
+                      --token-provider "$PARTY_A_ADDRESS:$PARTY_A_PAYMENT_SKEY" \
+                      --token-provider "$PARTY_B_ADDRESS:$PARTY_B_PAYMENT_SKEY" \
+                      --submit 600 \
+                      --out-file /dev/null
+
+
+echo "Sending back funds:"
+
+marlowe-cli -- util faucet --testnet-magic "$MAGIC" \
+                           --socket-path "$CARDANO_NODE_SOCKET_PATH" \
+                           --all-money \
+                           --faucet-address "$PARTY_A_ADDRESS" \
+                           --required-signer "$PARTY_A_PAYMENT_SKEY" \
+                           --submit 600 \
+                           --out-file /dev/null \
+                           "$FAUCET_ADDRESS"
+
+marlowe-cli -- util faucet --testnet-magic "$MAGIC" \
+                           --socket-path "$CARDANO_NODE_SOCKET_PATH" \
+                           --all-money \
+                           --faucet-address "$PARTY_B_ADDRESS" \
+                           --required-signer "$PARTY_B_PAYMENT_SKEY" \
+                           --submit 600 \
+                           --out-file /dev/null \
+                           "$FAUCET_ADDRESS"
 
-TX_CLEANUP_TOKEN_A=$(
-marlowe-cli util select --testnet-magic "$MAGIC"                   \
-                        --socket-path "$CARDANO_NODE_SOCKET_PATH"  \
-                        --asset-only "$TOKEN_A" "$PARTY_B_ADDRESS" \
-| sed -e 's/^TxIn "\(.*\)" (TxIx \(.*\))$/\1#\2/'                  \
-)
 
-marlowe-cli transaction simple --testnet-magic "$MAGIC"                            \
-                               --socket-path "$CARDANO_NODE_SOCKET_PATH"           \
-                               --tx-in "$TX_3"#0                                   \
-                               --tx-in "$TX_CLEANUP_TOKEN_A"                       \
-                               --tx-out "$BURN_ADDRESS+1500000+$AMOUNT_A $TOKEN_A" \
-                               --required-signer "$PARTY_B_PAYMENT_SKEY"           \
-                               --change-address "$FAUCET_ADDRESS"                  \
-                               --out-file /dev/null                                \
-                               --submit 600
+echo "Here are the UTxOs at the second party $PARTY_A_NAME's address after the cleanup:"
+
+cardano-cli query utxo --testnet-magic "$MAGIC" --address "$PARTY_A_ADDRESS"
+
+echo "Here are the UTxOs at the second party $PARTY_B_NAME's address after the cleanup:"
 
 cardano-cli query utxo --testnet-magic "$MAGIC" --address "$PARTY_B_ADDRESS"
+
+

marlowe-cli/marlowe-cli.cabal

@@ -53,6 +53,7 @@ library
     Language.Marlowe.CLI.Cardano.Api.Address
     Language.Marlowe.CLI.Cardano.Api.Address.ProofOfBurn
     Language.Marlowe.CLI.Cardano.Api.PlutusScript
+    Language.Marlowe.CLI.Cardano.Api.Value
     Language.Marlowe.CLI.Plutus.Script.Utils
     Language.Marlowe.CLI.Codec
     Language.Marlowe.CLI.Command
@@ -86,6 +87,7 @@ library
     base >= 4.9 && < 5,
     aeson,
     aeson-pretty,
+    appendmap -any,
     base16-bytestring,
     bech32,
     bytestring,
@@ -132,6 +134,7 @@ library
     servant,
     servant-client,
     split,
+    temporary,
     text,
     time,
     unordered-containers,

marlowe-cli/src/Language/Marlowe/CLI/Cardano/Api.hs

@@ -8,7 +8,9 @@
 
 
 module Language.Marlowe.CLI.Cardano.Api
-  ( adjustMinimumUTxO
+  ( Value.txOutValue
+  , Value.txOutValueValue
+  , adjustMinimumUTxO
   , toMultiAssetSupportedInEra
   , toPlutusProtocolVersion
   , toReferenceTxInsScriptsInlineDatumsSupportedInEra
@@ -41,6 +43,7 @@ import Cardano.Api.Shelley
   )
 import Control.Monad.Except (liftEither)
 import GHC.Natural (Natural, naturalToInteger)
+import qualified Language.Marlowe.CLI.Cardano.Api.Value as Value
 import Language.Marlowe.CLI.Orphans ()
 import Plutus.V1.Ledger.Api (ProtocolVersion(ProtocolVersion))
 import Plutus.V2.Ledger.Api (Datum(..), toData)

marlowe-cli/src/Language/Marlowe/CLI/Cardano/Api/Value.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE ViewPatterns #-}
+module Language.Marlowe.CLI.Cardano.Api.Value
+  where
+
+import qualified Cardano.Api as C
+import Language.Marlowe.CLI.Orphans ()
+import qualified Ledger.Tx.CardanoAPI as L
+import qualified Plutus.V1.Ledger.Value as P
+import qualified PlutusTx.Prelude as PlutusTx
+
+txOutValue :: C.TxOut ctx era -> C.TxOutValue era
+txOutValue (C.TxOut _ v _ _) = v
+
+
+txOutValueValue :: C.TxOut ctx era -> C.Value
+txOutValueValue (C.TxOut _ v _ _) = C.txOutValueToValue v
+
+
+toPlutusValue :: C.Value -> P.Value
+toPlutusValue (C.valueToList -> assets) = foldMap (uncurry assetToValue) assets
+
+
+lovelaceToPlutusValue :: C.Lovelace -> P.Value
+lovelaceToPlutusValue (C.Lovelace v) = P.singleton P.adaSymbol P.adaToken v
+
+
+assetToValue :: C.AssetId -> C.Quantity -> P.Value
+assetToValue (C.AssetId policyId assetName) (C.Quantity quantity) =
+  P.singleton (toCurrencySymbol policyId) (toTokenName assetName) quantity
+assetToValue C.AdaAssetId (C.Quantity quantity) =
+  P.singleton P.adaSymbol P.adaToken quantity
+
+
+toCurrencySymbol :: C.PolicyId -> P.CurrencySymbol
+toCurrencySymbol = P.mpsSymbol . L.fromCardanoPolicyId
+
+
+toTokenName :: C.AssetName -> P.TokenName
+toTokenName (C.AssetName bs) = P.TokenName $ PlutusTx.toBuiltin bs
+
+

marlowe-cli/src/Language/Marlowe/CLI/Command/Parse.hs

@@ -41,13 +41,15 @@ module Language.Marlowe.CLI.Command.Parse
   , parseTxOut
   , parseUrl
   , parseValue
+  , parseWallet
   , protocolVersionOpt
   , publishingStrategyOpt
   , readTokenName
   , requiredSignerOpt
   , requiredSignersOpt
   , timeoutHelpMsg
   , txBodyFileOpt
+  , walletOpt
   ) where
 
 
@@ -97,6 +99,7 @@ import Text.Read (readEither)
 import Text.Regex.Posix ((=~))
 
 import qualified Cardano.Api as C
+import Control.Category ((>>>))
 import qualified Data.ByteString.Base16 as Base16 (decode)
 import qualified Data.ByteString.Char8 as BS8 (pack)
 import Data.Maybe (fromMaybe)
@@ -439,6 +442,17 @@ requiredSignerOpt = SigningKeyFile <$> O.strOption (O.long "required-signer" <>
 requiredSignersOpt :: O.Parser [SigningKeyFile]
 requiredSignersOpt =  map SigningKeyFile <$> (O.some . O.strOption) (O.long "required-signer" <> O.metavar "SIGNING_FILE" <> O.help "File containing a required signing key.")
 
+parseWallet :: IsShelleyBasedEra era => O.ReadM (AddressInEra era, SigningKeyFile)
+parseWallet =
+  O.eitherReader
+    $ splitOn ":" >>> \case
+        [address, signingKeyFile] -> do
+            address' <- readAddressEither address
+            pure (address', SigningKeyFile signingKeyFile)
+        _  -> Left "Expecting address and signing key file path: ADDRESS:SIGNING_FILE"
+
+walletOpt :: IsShelleyBasedEra era => O.Mod O.OptionFields (AddressInEra era, SigningKeyFile) -> O.Parser (AddressInEra era, SigningKeyFile)
+walletOpt = O.option parseWallet
 
 txBodyFileOpt :: O.Parser TxBodyFile
 txBodyFileOpt = TxBodyFile <$> O.strOption (O.long "out-file" <> O.metavar "FILE"         <> O.help "Output file for transaction body.")
@@ -449,3 +463,4 @@ publishingStrategyOpt =
       PublishAtAddress <$> O.option parseAddress                 (O.long "at-address"                     <> O.metavar "ADDRESS"          <> O.help "Publish script at a given address. This is a default strategy which uses change address as a destination.")
   <|> PublishPermanently <$> O.option parseStakeAddressReference (O.long "permanently"                    <> O.metavar "STAKING_ADDRESS"  <> O.help "Publish permanently at unspendable script address staking the min. ADA value.")
   <|> O.flag' (PublishPermanently C.NoStakeAddress)              (O.long "permanently-without-staking"                                    <> O.help "Publish permanently at unspendable script address without min. ADA staking.")
+