Merge pull request #751 from input-output-hk/plt-8244-multiple-tokens…

…-per-role Plt 8244 multiple tokens per role
input-output-hk · Nov 20, 2023 · 2d2d9a4 · 2d2d9a4
2 parents b45502b + e97f60b
commit 2d2d9a4
Show file tree

Hide file tree

Showing 41 changed files with 1,929 additions and 1,485 deletions.
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
@@ -63,7 +63,8 @@ jobs:
         run: |
           result/bin/marlowe-integration-tests --strict > ~/integration-tests.log
           echo $? > ~/integration-tests.status
-          exit $?
+          cat ~/integration-tests.log
+          exit $(cat ~/integration-tests.status)
         env:
           MARLOWE_RT_TEST_DB_HOST: localhost
           MARLOWE_RT_TEST_CLEANUP_DATABASE: "False"
@@ -77,8 +78,8 @@ jobs:
             /tmp/workspaces
             !/tmp/workspaces/**/*.socket
       - if: ${{ steps.cache-results.outputs.cache-hit == 'true' }}
-        name: Display cached test results
+        name: Display test results
         run: |
-          echo "Using cached test results. Test log:"
+          echo "Test log:"
           cat ~/integration-tests.log
           exit $(cat ~/integration-tests.status)
diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Language.Marlowe.Runtime.App.Build (
@@ -13,7 +12,7 @@ module Language.Marlowe.Runtime.App.Build (
   buildWithdrawal,
 ) where
 
-import Data.Bifunctor (bimap, second)
+import Data.Bifunctor (bimap)
 import Data.Time (UTCTime, secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Void (Void)
@@ -56,9 +55,11 @@ buildCreation version' contract roles minUtxo metadata' =
   let roles' =
         if M.null roles
           then RoleTokensNone
-          else RoleTokensMint . mkMint . fmap (second $ (,Nothing) . ToAddress) . NE.fromList . M.toList $ roles
+          else
+            RoleTokensMint . mkMint . fmap (\(token, addr) -> (token, Nothing, ToAddress addr, 1)) . NE.fromList . M.toList $
+              roles
    in build show (\(ContractCreated era ContractCreatedInEra{..}) -> (contractId, TxBodyInEraWithReferenceScripts era txBody)) $
-        \w -> Create Nothing version' w roles' metadata' minUtxo $ Left contract
+        \w -> Create Nothing version' w Nothing roles' metadata' minUtxo $ Left contract
 
 buildApplication
   :: MarloweVersion v

diff --git a/marlowe-chain-sync/gen/Language/Marlowe/Runtime/ChainSync/Gen.hs b/marlowe-chain-sync/gen/Language/Marlowe/Runtime/ChainSync/Gen.hs
@@ -163,7 +163,7 @@ instance Arbitrary PolicyId where
   arbitrary = PolicyId . unScriptHash <$> arbitrary
 
 instance Arbitrary TokenName where
-  arbitrary = TokenName <$> genBytes
+  arbitrary = TokenName . BS.take 32 <$> genBytes
   shrink = genericShrink
 
 instance Arbitrary Datum where

diff --git a/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs b/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
@@ -465,7 +465,7 @@ interpret ro@RuntimeCreateContract{..} = do
     Just roleCurrency -> do
       Currency{ccPolicyId = cardanoPolicyId} <- getCurrency roleCurrency
       let policyId = MRCA.fromCardanoPolicyId cardanoPolicyId
-      pure $ RoleTokensUsePolicy policyId
+      pure $ RoleTokensUsePolicy policyId mempty
     Nothing -> pure RoleTokensNone
 
   let (contract, possibleContinuations) = case roMerkleize of
@@ -513,6 +513,7 @@ interpret ro@RuntimeCreateContract{..} = do
             Nothing
             MarloweV1
             walletAddresses
+            Nothing
             roleTokensConfig
             marloweTransactionMetadata
             minLovelace

diff --git a/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs b/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs
@@ -30,6 +30,7 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   DatumHash,
   Lovelace,
   StakeCredential,
+  TokenName,
   TxId,
   TxOutRef,
  )
@@ -214,6 +215,8 @@ createContract
   -- ^ The Marlowe version to use
   -> WalletAddresses
   -- ^ The wallet addresses to use when constructing the transaction
+  -> Maybe TokenName
+  -- ^ An optional thread token name. Defaults to an empty string.
   -> RoleTokensConfig
   -- ^ How to initialize role tokens
   -> MarloweTransactionMetadata
@@ -223,13 +226,14 @@ createContract
   -> Either (Contract v) DatumHash
   -- ^ The contract to run, or the hash of the contract to look up in the store.
   -> m (Either CreateError (ContractCreated v))
-createContract mStakeCredential version wallet roleTokens metadata lovelace contract =
+createContract mStakeCredential version wallet threadName roleTokens metadata lovelace contract =
   runMarloweTxClient $
     liftCommand $
       Create
         mStakeCredential
         version
         wallet
+        threadName
         roleTokens
         metadata
         lovelace

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs
@@ -119,7 +119,7 @@ serializeAddress = Text.unpack . Maybe.fromJust . ChainSync.Api.toBech32
 
 toCliArgs :: MarloweTxCommand Void err result -> [String]
 toCliArgs = \case
-  Create _ MarloweV1 WalletAddresses{changeAddress, extraAddresses} _ _ minAdaDeposit _ ->
+  Create _ MarloweV1 WalletAddresses{changeAddress, extraAddresses} _ _ _ minAdaDeposit _ ->
     ["create", "--change-address", serializeAddress changeAddress]
       <> do address <- Set.toList extraAddresses; ["--address", serializeAddress address]
       <> do
@@ -162,7 +162,7 @@ toCliArgs = \case
 
 marloweRuntimeJobClient :: MarloweTxCommand Void err result -> Integration result
 marloweRuntimeJobClient = \case
-  cmd@(Create _ MarloweV1 _ _ _ _ _) ->
+  cmd@(Create _ MarloweV1 _ _ _ _ _ _) ->
     runMarloweTxClient (JobClient.liftCommand cmd) >>= \case
       Left err -> error ("Some JobClient create error: " <> show err)
       Right result -> pure result
@@ -269,6 +269,7 @@ createSpec = describe "create" $
             Nothing
             MarloweV1
             addresses
+            Nothing
             Runtime.Transaction.Api.RoleTokensNone
             md
             Nothing
@@ -300,9 +301,10 @@ depositSpec = describe "deposit" $
           Nothing
           MarloweV1
           (addresses partyAWallet)
+          Nothing
           ( Runtime.Transaction.Api.RoleTokensMint $
               Runtime.Transaction.Api.mkMint $
-                pure ("Party A", (ToAddress . changeAddress $ addresses partyAWallet, Nothing))
+                pure ("Party A", Nothing, ToAddress $ changeAddress $ addresses partyAWallet, 1)
           )
           (standardMetadata tags)
           Nothing
@@ -355,9 +357,10 @@ chooseSpec = describe "choose" $
           Nothing
           MarloweV1
           (addresses partyAWallet)
+          Nothing
           ( Runtime.Transaction.Api.RoleTokensMint $
               Runtime.Transaction.Api.mkMint $
-                pure ("Party A", (ToAddress . changeAddress $ addresses partyAWallet, Nothing))
+                pure ("Party A", Nothing, ToAddress $ changeAddress $ addresses partyAWallet, 1)
           )
           (standardMetadata tags)
           Nothing
@@ -407,9 +410,10 @@ notifySpec = describe "notify" $
           Nothing
           MarloweV1
           (addresses partyAWallet)
+          Nothing
           ( Runtime.Transaction.Api.RoleTokensMint $
               Runtime.Transaction.Api.mkMint $
-                pure ("Party A", (ToAddress . changeAddress $ addresses partyAWallet, Nothing))
+                pure ("Party A", Nothing, ToAddress $ changeAddress $ addresses partyAWallet, 1)
           )
           (standardMetadata tags)
           Nothing
@@ -482,9 +486,10 @@ applySpec = describe "apply" $
           Nothing
           MarloweV1
           (addresses partyAWallet)
+          Nothing
           ( Runtime.Transaction.Api.RoleTokensMint $
               Runtime.Transaction.Api.mkMint $
-                pure ("Party A", (ToAddress . changeAddress $ addresses partyAWallet, Nothing))
+                pure ("Party A", Nothing, ToAddress $ changeAddress $ addresses partyAWallet, 1)
           )
           (standardMetadata tags)
           Nothing
@@ -541,9 +546,10 @@ withdrawSpec = describe "withdraw" $
           Nothing
           MarloweV1
           (addresses partyAWallet)
+          Nothing
           ( Runtime.Transaction.Api.RoleTokensMint $
               Runtime.Transaction.Api.mkMint $
-                pure ("Party A", (ToAddress . changeAddress $ addresses partyAWallet, Nothing))
+                pure ("Party A", Nothing, ToAddress $ changeAddress $ addresses partyAWallet, 1)
           )
           (standardMetadata tags)
           Nothing