From 85ce83309ca30daf05c232004f5ca344c2298567 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 13:18:55 -0600
Subject: [PATCH 01/10] Change Withdraw to accept tx outs instead of a contract
 id

---
 .../Marlowe/Runtime/Transaction/Gen.hs        |  49 +--
 marlowe-runtime/marlowe-runtime/Logging.hs    |   6 +
 marlowe-runtime/marlowe-tx/Logging.hs         |   6 +
 marlowe-runtime/marlowe-tx/Main.hs            |   8 +
 .../runtime/Language/Marlowe/Runtime.hs       |   4 +
 .../Transaction/BuildConstraintsSpec.hs       |  73 ++--
 .../Runtime/Transaction/ConstraintsSpec.hs    | 263 ++++++++------
 .../Marlowe/Runtime/Transaction/SafetySpec.hs |   1 -
 .../Marlowe/Runtime/Transaction/Api.hs        | 134 ++++----
 .../Language/Marlowe/Runtime/Transaction.hs   |  34 +-
 .../Runtime/Transaction/BuildConstraints.hs   |  56 +--
 .../Runtime/Transaction/Constraints.hs        | 320 ++++++++++--------
 .../Marlowe/Runtime/Transaction/Query.hs      | 121 ++++---
 .../Marlowe/Runtime/Transaction/Safety.hs     |   2 +-
 .../Marlowe/Runtime/Transaction/Server.hs     |  56 ++-
 15 files changed, 644 insertions(+), 489 deletions(-)

diff --git a/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs b/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
index be7c9c0c2a..5f8a3997c4 100644
--- a/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
+++ b/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
@@ -131,27 +131,25 @@ instance Arbitrary LoadMarloweContextError where
       ]
   shrink = genericShrink
 
-instance (ArbitraryMarloweVersion v) => Arbitrary (ConstraintError v) where
+instance Arbitrary ConstraintError where
   arbitrary =
     oneof
       [ MintingUtxoNotFound <$> arbitrary
       , RoleTokenNotFound <$> arbitrary
       , pure ToCardanoError
       , pure MissingMarloweInput
-      , PayoutInputNotFound <$> arbitrary
+      , PayoutNotFound <$> arbitrary
       , CalculateMinUtxoFailed <$> arbitrary
       , CoinSelectionFailed <$> arbitrary
       , BalancingError <$> arbitrary
+      , InvalidPayoutDatum <$> arbitrary <*> arbitrary
+      , InvalidPayoutScriptAddress <$> arbitrary <*> arbitrary
+      , pure MarloweInputInWithdraw
+      , pure MarloweOutputInWithdraw
+      , pure PayoutOutputInWithdraw
+      , pure PayoutInputInCreateOrApply
       ]
-  shrink = \case
-    MintingUtxoNotFound err -> MintingUtxoNotFound <$> shrink err
-    RoleTokenNotFound _ -> []
-    ToCardanoError -> []
-    MissingMarloweInput -> []
-    PayoutInputNotFound _ -> []
-    CalculateMinUtxoFailed err -> CalculateMinUtxoFailed <$> shrink err
-    CoinSelectionFailed err -> CoinSelectionFailed <$> shrink err
-    BalancingError err -> BalancingError <$> shrink err
+  shrink = genericShrink
 
 instance Arbitrary CreateBuildupError where
   arbitrary =
@@ -162,7 +160,7 @@ instance Arbitrary CreateBuildupError where
       ]
   shrink = genericShrink
 
-instance (ArbitraryMarloweVersion v) => Arbitrary (CreateError v) where
+instance Arbitrary CreateError where
   arbitrary =
     oneof
       [ CreateConstraintError <$> arbitrary
@@ -181,7 +179,7 @@ instance Arbitrary ApplyInputsConstraintsBuildupError where
       ]
   shrink = genericShrink
 
-instance (ArbitraryMarloweVersion v) => Arbitrary (ApplyInputsError v) where
+instance Arbitrary ApplyInputsError where
   arbitrary =
     oneof
       [ ApplyInputsEraUnsupported <$> arbitrary
@@ -195,12 +193,11 @@ instance (ArbitraryMarloweVersion v) => Arbitrary (ApplyInputsError v) where
       ]
   shrink = genericShrink
 
-instance (ArbitraryMarloweVersion v) => Arbitrary (WithdrawError v) where
+instance Arbitrary WithdrawError where
   arbitrary =
     oneof
       [ WithdrawConstraintError <$> arbitrary
       , WithdrawEraUnsupported <$> arbitrary
-      , WithdrawLoadMarloweContextFailed <$> arbitrary
       , UnableToFindPayoutForAGivenRole <$> arbitrary
       ]
   shrink = genericShrink
@@ -275,7 +272,6 @@ instance (ArbitraryMarloweVersion v, IsCardanoEra era) => Arbitrary (WithdrawTxI
   arbitrary =
     WithdrawTxInEra Core.marloweVersion
       <$> arbitrary
-      <*> arbitrary
       <*> hedgehog (genTxBody cardanoEra)
   shrink WithdrawTxInEra{..} = [WithdrawTxInEra{..}{WithdrawTxInEra.inputs = inputs'} | inputs' <- shrink inputs]
 
@@ -309,7 +305,6 @@ instance ArbitraryCommand MarloweTxCommand where
       Withdraw Core.MarloweV1
         <$> arbitrary
         <*> arbitrary
-        <*> arbitrary
     TagSubmit -> Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> hedgehog (genTx BabbageEra)
   arbitraryJobId = \case
     TagCreate Core.MarloweV1 -> Nothing
@@ -393,18 +388,9 @@ instance ArbitraryCommand MarloweTxCommand where
         , ApplyInputs Core.MarloweV1 wallet contractId meta minValid maxValid
             <$> shrink inputs
         ]
-    Withdraw Core.MarloweV1 wallet contractId role ->
-      concat
-        [ Withdraw Core.MarloweV1
-            <$> shrink wallet
-            <*> pure contractId
-            <*> pure role
-        , Withdraw Core.MarloweV1 wallet
-            <$> shrink contractId
-            <*> pure role
-        , Withdraw Core.MarloweV1 wallet contractId
-            <$> shrink role
-        ]
+    Withdraw Core.MarloweV1 wallet payouts ->
+      (Withdraw Core.MarloweV1 <$> shrink wallet <*> pure payouts)
+        <> (Withdraw Core.MarloweV1 wallet <$> shrink payouts)
     Submit _ _ -> []
   shrinkJobId = \case
     JobIdSubmit txId -> JobIdSubmit <$> shrink txId
@@ -451,10 +437,7 @@ instance CommandVariations MarloweTxCommand where
           `varyAp` variations
           `varyAp` variations
     TagWithdraw Core.MarloweV1 ->
-      Withdraw Core.MarloweV1
-        <$> variations
-          `varyAp` variations
-          `varyAp` variations
+      Withdraw Core.MarloweV1 <$> variations `varyAp` variations
     TagSubmit ->
       Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra
         <$> variations
diff --git a/marlowe-runtime/marlowe-runtime/Logging.hs b/marlowe-runtime/marlowe-runtime/Logging.hs
index 55fd889216..4e51dd39c4 100644
--- a/marlowe-runtime/marlowe-runtime/Logging.hs
+++ b/marlowe-runtime/marlowe-runtime/Logging.hs
@@ -31,6 +31,7 @@ import qualified Language.Marlowe.Runtime.Sync as Sync
 import qualified Language.Marlowe.Runtime.Sync.Database as Sync
 import Language.Marlowe.Runtime.Transaction (
   renderLoadMarloweContextSelectorOTel,
+  renderLoadPayoutContextSelectorOTel,
   renderLoadWalletContextSelectorOTel,
   renderTransactionServerSelectorOTel,
  )
@@ -56,6 +57,7 @@ data RootSelector f where
   MarloweTx :: TransactionServerSelector f -> RootSelector f
   LoadWalletContext :: Q.LoadWalletContextSelector f -> RootSelector f
   LoadMarloweContext :: Q.LoadMarloweContextSelector f -> RootSelector f
+  LoadPayoutContext :: Q.LoadPayoutContextSelector f -> RootSelector f
   ContractStoreSelector :: ContractStoreSelector f -> RootSelector f
 
 instance Inject RootSelector RootSelector where
@@ -91,6 +93,9 @@ instance Inject Q.LoadWalletContextSelector RootSelector where
 instance Inject Q.LoadMarloweContextSelector RootSelector where
   inject = injectSelector LoadMarloweContext
 
+instance Inject Q.LoadPayoutContextSelector RootSelector where
+  inject = injectSelector LoadPayoutContext
+
 instance Inject TransactionServerSelector RootSelector where
   inject = injectSelector MarloweTx
 
@@ -132,4 +137,5 @@ renderRootSelectorOTel dbName dbUser host port = \case
   MarloweTx sel -> renderTransactionServerSelectorOTel sel
   LoadWalletContext sel -> renderLoadWalletContextSelectorOTel sel
   LoadMarloweContext sel -> renderLoadMarloweContextSelectorOTel sel
+  LoadPayoutContext sel -> renderLoadPayoutContextSelectorOTel sel
   ContractStoreSelector sel -> renderContractStoreSelectorOTel sel
diff --git a/marlowe-runtime/marlowe-tx/Logging.hs b/marlowe-runtime/marlowe-tx/Logging.hs
index e5e74cd4a1..7f285569e5 100644
--- a/marlowe-runtime/marlowe-tx/Logging.hs
+++ b/marlowe-runtime/marlowe-tx/Logging.hs
@@ -11,6 +11,7 @@ import Language.Marlowe.Runtime.ChainSync.Api (ChainSyncCommand, ChainSyncQuery)
 import Language.Marlowe.Runtime.Contract.Api (ContractRequest)
 import Language.Marlowe.Runtime.Transaction (
   renderLoadMarloweContextSelectorOTel,
+  renderLoadPayoutContextSelectorOTel,
   renderLoadWalletContextSelectorOTel,
   renderTransactionServerSelectorOTel,
  )
@@ -37,6 +38,7 @@ data RootSelector f where
   App :: TransactionServerSelector f -> RootSelector f
   LoadWalletContext :: Q.LoadWalletContextSelector f -> RootSelector f
   LoadMarloweContext :: Q.LoadMarloweContextSelector f -> RootSelector f
+  LoadPayoutContext :: Q.LoadPayoutContextSelector f -> RootSelector f
 
 instance Inject RootSelector RootSelector where
   inject = idInjectSelector
@@ -47,6 +49,9 @@ instance Inject Q.LoadWalletContextSelector RootSelector where
 instance Inject Q.LoadMarloweContextSelector RootSelector where
   inject = injectSelector LoadMarloweContext
 
+instance Inject Q.LoadPayoutContextSelector RootSelector where
+  inject = injectSelector LoadPayoutContext
+
 instance Inject TransactionServerSelector RootSelector where
   inject = injectSelector App
 
@@ -59,3 +64,4 @@ renderRootSelectorOTel = \case
   App sel -> renderTransactionServerSelectorOTel sel
   LoadWalletContext sel -> renderLoadWalletContextSelectorOTel sel
   LoadMarloweContext sel -> renderLoadMarloweContextSelectorOTel sel
+  LoadPayoutContext sel -> renderLoadPayoutContextSelectorOTel sel
diff --git a/marlowe-runtime/marlowe-tx/Main.hs b/marlowe-runtime/marlowe-tx/Main.hs
index 972d9dfbad..345f7ffb1f 100644
--- a/marlowe-runtime/marlowe-tx/Main.hs
+++ b/marlowe-runtime/marlowe-tx/Main.hs
@@ -89,6 +89,14 @@ run Options{..} = flip runComponent_ () proc _ -> do
               networkId <- runConnector chainSyncQueryConnector $ request GetNetworkId
               Query.loadMarloweContext ScriptRegistry.getScripts networkId chainSyncConnector chainSyncQueryConnector v contractId
           , loadWalletContext = Query.loadWalletContext $ runConnector chainSyncQueryConnector . request . GetUTxOs
+          , loadPayoutContext = \v payouts -> do
+              networkId <- runConnector chainSyncQueryConnector $ request GetNetworkId
+              Query.loadPayoutContext
+                ScriptRegistry.getScripts
+                networkId
+                (runConnector chainSyncQueryConnector . request . GetUTxOs)
+                v
+                payouts
           , getCurrentScripts = ScriptRegistry.getCurrentScripts
           , analysisTimeout = analysisTimeout
           , ..
diff --git a/marlowe-runtime/runtime/Language/Marlowe/Runtime.hs b/marlowe-runtime/runtime/Language/Marlowe/Runtime.hs
index f69775fc51..d5f8b76501 100644
--- a/marlowe-runtime/runtime/Language/Marlowe/Runtime.hs
+++ b/marlowe-runtime/runtime/Language/Marlowe/Runtime.hs
@@ -55,8 +55,10 @@ import qualified Language.Marlowe.Runtime.Transaction as MarloweTx
 import qualified Language.Marlowe.Runtime.Transaction as Tx
 import Language.Marlowe.Runtime.Transaction.Query (
   LoadMarloweContextSelector,
+  LoadPayoutContextSelector,
   LoadWalletContextSelector,
   loadMarloweContext,
+  loadPayoutContext,
   loadWalletContext,
  )
 import Language.Marlowe.Runtime.Transaction.Server (TransactionServerSelector)
@@ -120,6 +122,7 @@ marloweRuntime
      , Inject TransactionServerSelector s
      , Inject LoadWalletContextSelector s
      , Inject LoadMarloweContextSelector s
+     , Inject LoadPayoutContextSelector s
      , WithLog env Message m
      )
   => Component m (MarloweRuntimeDependencies r n m) (MarloweRuntime m)
@@ -192,6 +195,7 @@ marloweRuntime = proc MarloweRuntimeDependencies{..} -> do
           { mkSubmitJob = mkSubmitJob SubmitJobDependencies{..}
           , loadWalletContext = loadWalletContext $ runConnector chainSyncQueryConnector . request . GetUTxOs
           , loadMarloweContext = loadMarloweContext getScripts networkId chainSyncConnector chainSyncQueryConnector
+          , loadPayoutContext = loadPayoutContext getScripts networkId $ runConnector chainSyncQueryConnector . request . GetUTxOs
           , analysisTimeout = 15 -- seconds
           , ..
           }
diff --git a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/BuildConstraintsSpec.hs b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/BuildConstraintsSpec.hs
index 71d7d18cd1..20ff977233 100644
--- a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/BuildConstraintsSpec.hs
+++ b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/BuildConstraintsSpec.hs
@@ -9,18 +9,22 @@ module Language.Marlowe.Runtime.Transaction.BuildConstraintsSpec (
 
 import Cardano.Api (BabbageEra, ConsensusMode (..), EraHistory (EraHistory), SlotNo (SlotNo))
 import Cardano.Api.Shelley (ReferenceTxInsScriptsInlineDatumsSupportedInEra (..))
-import Control.Monad.Trans.Except (runExcept)
+import Control.Monad.Trans.Except (runExcept, runExceptT)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Function (on)
+import Data.Functor ((<&>))
+import Data.Functor.Identity (Identity (..))
 import Data.List (isPrefixOf)
 import qualified Data.List.NonEmpty as NE
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Maybe (maybeToList)
 import Data.SOP.Strict (K (..), NP (..))
 import qualified Data.Set as Set
 import Data.Time (UTCTime, nominalDiffTimeToSeconds, secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
+import Data.Traversable (for)
 import GHC.Generics (Generic)
 import qualified Language.Marlowe.Core.V1.Semantics as Semantics
 import qualified Language.Marlowe.Core.V1.Semantics.Types as Semantics
@@ -52,6 +56,7 @@ import qualified Language.Marlowe.Runtime.Transaction.BuildConstraints as BuildC
 import Language.Marlowe.Runtime.Transaction.Constraints (
   MarloweInputConstraints (..),
   MarloweOutputConstraints (..),
+  PayoutContext (..),
   RoleTokenConstraints (..),
   TxConstraints (..),
   WalletContext (..),
@@ -193,7 +198,7 @@ extractMarloweAssets TxConstraints{..} = case marloweOutputConstraints of
   MarloweOutput assets _ -> Just assets
   _ -> Nothing
 
-runBuildCreateConstraints :: CreateArgs v -> Either (CreateError v) (TxConstraints BabbageEra v)
+runBuildCreateConstraints :: CreateArgs v -> Either CreateError (TxConstraints BabbageEra v)
 runBuildCreateConstraints CreateArgs{..} =
   snd
     <$> buildCreateConstraints
@@ -265,31 +270,53 @@ instance Show SomeCreateArgs where
 
 withdrawSpec :: Spec
 withdrawSpec = Hspec.describe "buildWithdrawConstraints" do
-  Hspec.QuickCheck.prop "implements Marlowe V1" do
-    tokenName <- Chain.TokenName <$> byteStringGen
-    policyId <- Chain.PolicyId <$> byteStringGen
+  Hspec.QuickCheck.prop "builds the correct constraints" \payouts' payout -> do
+    let payouts = Set.insert payout payouts'
+    forAllShrink (genPayoutContext payouts) shrinkPayoutContext \(roleTokens, payoutContext) -> do
+      let actual :: Either Transaction.Api.WithdrawError (TxConstraints BabbageEra 'Core.Api.V1)
+          actual = runIdentity $ runExceptT $ snd <$> BuildConstraints.buildWithdrawConstraints payoutContext Core.Api.MarloweV1 payouts
 
-    let assetId :: Chain.AssetId
-        assetId = Chain.AssetId policyId tokenName
+          expected :: Either Transaction.Api.WithdrawError (TxConstraints BabbageEra 'Core.Api.V1)
+          expected =
+            Right $
+              TxConstraints
+                { marloweInputConstraints = TxConstraints.MarloweInputConstraintsNone
+                , payoutInputConstraints = payouts
+                , roleTokenConstraints = TxConstraints.SpendRoleTokens roleTokens
+                , payToAddresses = Map.empty
+                , payToRoles = Map.empty
+                , marloweOutputConstraints = TxConstraints.MarloweOutputConstraintsNone
+                , signatureConstraints = Set.empty
+                , metadataConstraints = emptyMarloweTransactionMetadata
+                }
 
-        actual :: Either (Transaction.Api.WithdrawError 'Core.Api.V1) (TxConstraints BabbageEra 'Core.Api.V1)
-        actual = BuildConstraints.buildWithdrawConstraints Core.Api.MarloweV1 assetId
+      actual `shouldBe` expected
 
-        expected :: Either (Transaction.Api.WithdrawError 'Core.Api.V1) (TxConstraints BabbageEra 'Core.Api.V1)
-        expected =
-          Right $
-            TxConstraints
-              { marloweInputConstraints = TxConstraints.MarloweInputConstraintsNone
-              , payoutInputConstraints = Set.singleton assetId
-              , roleTokenConstraints = TxConstraints.SpendRoleTokens $ Set.singleton assetId
-              , payToAddresses = Map.empty
-              , payToRoles = Map.empty
-              , marloweOutputConstraints = TxConstraints.MarloweOutputConstraintsNone
-              , signatureConstraints = Set.empty
-              , metadataConstraints = emptyMarloweTransactionMetadata
-              }
+shrinkPayoutContext :: (Set.Set Chain.AssetId, PayoutContext) -> [(Set.Set Chain.AssetId, PayoutContext)]
+shrinkPayoutContext (roleTokens, PayoutContext{..}) = (roleTokens,) <$> contextShrinks
+  where
+    contextShrinks = flip PayoutContext payoutScriptOutputs <$> foldMap shrinkPayoutOutput (Map.keys payoutOutputs)
+
+    shrinkPayoutOutput :: Chain.TxOutRef -> [Map Chain.TxOutRef Chain.TransactionOutput]
+    shrinkPayoutOutput payout = do
+      Chain.TransactionOutput{..} <- maybeToList $ Map.lookup payout payoutOutputs
+      flip (Map.insert payout) payoutOutputs
+        <$> [Chain.TransactionOutput{address = address', ..} | address' <- shrink address]
+          <> [Chain.TransactionOutput{assets = assets', ..} | assets' <- shrink assets]
 
-    pure $ actual `shouldBe` expected
+genPayoutContext :: Set.Set Chain.TxOutRef -> QuickCheck.Gen (Set.Set Chain.AssetId, TxConstraints.PayoutContext)
+genPayoutContext payouts = do
+  relations <- for (Set.toAscList payouts) \payout -> do
+    roleToken <- arbitrary
+    output <- arbitrary
+    pure (payout, roleToken, output{Chain.datum = Just $ Core.Api.toChainPayoutDatum MarloweV1 roleToken})
+  pure
+    ( Set.fromList $ relations <&> \(_, roleToken, _) -> roleToken
+    , PayoutContext
+        { payoutOutputs = Map.fromDistinctAscList $ relations <&> \(payout, _, txOut) -> (payout, txOut)
+        , payoutScriptOutputs = mempty
+        }
+    )
 
 buildApplyInputsConstraintsSpec :: Spec
 buildApplyInputsConstraintsSpec =
diff --git a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ConstraintsSpec.hs b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ConstraintsSpec.hs
index 66836fc390..b3a7904458 100644
--- a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ConstraintsSpec.hs
+++ b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ConstraintsSpec.hs
@@ -14,7 +14,7 @@ import Cardano.Api.Shelley (
   SimpleScriptOrReferenceInput (SReferenceScript),
  )
 import Control.Applicative (Alternative)
-import Control.Arrow ((***))
+import Control.Arrow (Arrow ((&&&), (***)))
 import Control.Error (note)
 import Control.Monad (guard)
 import Data.Bifunctor (first)
@@ -32,6 +32,7 @@ import Data.Monoid (First (..), getFirst)
 import Data.Ratio ((%))
 import Data.SOP.Strict (K (..), NP (Nil, (:*)))
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import Data.Traversable (for)
 import Data.Word (Word32)
 import GHC.Word (Word64)
@@ -48,7 +49,12 @@ import Gen.Cardano.Api.Typed (
 import Language.Marlowe (MarloweData (..), MarloweParams (..), txInputs)
 import qualified Language.Marlowe.Core.V1.Semantics.Types as V1
 import Language.Marlowe.Runtime.Cardano.Api
-import Language.Marlowe.Runtime.ChainSync.Api (fromCardanoPaymentKeyHash, fromCardanoScriptHash, unTransactionMetadata)
+import Language.Marlowe.Runtime.ChainSync.Api (
+  fromCardanoPaymentKeyHash,
+  fromCardanoScriptHash,
+  renderTxOutRef,
+  unTransactionMetadata,
+ )
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import qualified Language.Marlowe.Runtime.ChainSync.Gen ()
 import Language.Marlowe.Runtime.Core.Api (
@@ -56,7 +62,6 @@ import Language.Marlowe.Runtime.Core.Api (
   Inputs,
   MarloweVersion (..),
   MarloweVersionTag (..),
-  Payout (..),
   TransactionScriptOutput (..),
   encodeMarloweTransactionMetadata,
   toChainDatum,
@@ -89,22 +94,25 @@ spec = do
   describe "solveInitialTxBodyContent" do
     prop "satisfies the constraints" \(SomeTxConstraints marloweVersion constraints) -> do
       protocol <- hedgehog genProtocolParameters
-      marloweContext <- genMarloweContext marloweVersion constraints
+      scriptCtx <- genScriptContext marloweVersion constraints
       walletContext <- genWalletContext marloweVersion constraints
-      let (marloweContextStr, walletContextStr) = case marloweVersion of MarloweV1 -> (show marloweContext, show walletContext)
-          marloweUtxo = case scriptOutput marloweContext of
-            Nothing -> mempty
-            Just TransactionScriptOutput{..} ->
+      let (scriptContextStr, walletContextStr) = case marloweVersion of MarloweV1 -> (show scriptCtx, show walletContext)
+          marloweUtxo = case scriptCtx of
+            Left MarloweContext{scriptOutput = Just TransactionScriptOutput{..}} ->
               Chain.UTxOs $
                 Map.singleton utxo $
                   Chain.TransactionOutput address assets Nothing (Just $ toChainDatum marloweVersion datum)
-          payoutToTransactionOutput Payout{..} = Chain.TransactionOutput address assets Nothing (Just $ toChainPayoutDatum marloweVersion datum)
-          payoutUtxos = Chain.UTxOs $ payoutToTransactionOutput <$> payoutOutputs marloweContext
+            _ -> mempty
+          payoutUtxos = Chain.UTxOs case scriptCtx of
+            Left _ -> mempty
+            Right PayoutContext{..} -> payoutOutputs
           referenceScriptUtxoToUtxo ReferenceScriptUtxo{..} = (txOutRef, txOut)
           referenceUtxos =
             Chain.UTxOs $
               Map.fromList $
-                referenceScriptUtxoToUtxo <$> [marloweScriptUTxO marloweContext, payoutScriptUTxO marloweContext]
+                referenceScriptUtxoToUtxo <$> case scriptCtx of
+                  Left MarloweContext{..} -> [marloweScriptUTxO, payoutScriptUTxO]
+                  Right PayoutContext{..} -> Map.elems payoutScriptOutputs
           utxosFromMarloweContext = marloweUtxo <> payoutUtxos <> referenceUtxos
           utxos = utxosFromMarloweContext <> availableUtxos walletContext
           result =
@@ -112,15 +120,15 @@ spec = do
               ReferenceTxInsScriptsInlineDatumsInBabbageEra
               protocol
               marloweVersion
-              marloweContext
+              scriptCtx
               walletContext
               constraints
-          mViolations = violations marloweVersion marloweContext utxos constraints <$> result
+          mViolations = violations marloweVersion scriptCtx utxos constraints <$> result
           theProperty :: Property
           theProperty = case marloweVersion of
             MarloweV1 -> Right [] === mViolations
       pure $
-        counterexample marloweContextStr $
+        counterexample scriptContextStr $
           counterexample walletContextStr $
             counterexample (show utxos) $
               either (const theProperty) (flip counterexample theProperty . show) result
@@ -163,8 +171,12 @@ spec = do
 
       let actual =
             getValueAtAddress marloweAddressChain . txOuts
-              <$> adjustTxForMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet marloweAddressChain txBodyContent
-          expected :: Either (ConstraintError 'V1) (Maybe (TxOutValue BabbageEra)) =
+              <$> adjustTxForMinUtxo
+                ReferenceTxInsScriptsInlineDatumsInBabbageEra
+                protocolTestnet
+                (Just marloweAddressChain)
+                txBodyContent
+          expected :: Either ConstraintError (Maybe (TxOutValue BabbageEra)) =
             Right $ getValueAtAddress marloweAddressChain $ txOuts txBodyContent
 
       pure $ actual `shouldBe` expected
@@ -196,13 +208,13 @@ spec = do
 
       txBodyContent <- hedgehog $ genTxBodyContent BabbageEra
 
-      pure $ case adjustTxForMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet marloweAddress txBodyContent of
+      pure $ case adjustTxForMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (Just marloweAddress) txBodyContent of
         Right newTxBodyContent -> do
           let errors = mapMaybe valueMeetsMinimumReq $ txOuts newTxBodyContent
           if null errors
             then pure ()
             else expectationFailure $ unlines $ "Minimum UTxO requirements not met:" : errors
-        Left (msgFromAdjustment :: ConstraintError 'V1) -> expectationFailure $ show msgFromAdjustment
+        Left (msgFromAdjustment :: ConstraintError) -> expectationFailure $ show msgFromAdjustment
 
     prop "all outputs are at least half an ADA" do
       marloweScriptHash <- hedgehog genScriptHash
@@ -223,13 +235,13 @@ spec = do
 
       txBodyContent <- hedgehog $ genTxBodyContent BabbageEra
 
-      pure $ case adjustTxForMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet marloweAddress txBodyContent of
+      pure $ case adjustTxForMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (Just marloweAddress) txBodyContent of
         Right newTxBodyContent -> do
           let errors = mapMaybe valueIsAtLeastHalfAnAda $ txOuts newTxBodyContent
           if null errors
             then pure ()
             else expectationFailure $ unlines $ "Minimum UTxO requirements not met:" : errors
-        Left (msgFromAdjustment :: ConstraintError 'V1) -> expectationFailure $ show msgFromAdjustment
+        Left (msgFromAdjustment :: ConstraintError) -> expectationFailure $ show msgFromAdjustment
 
   describe "selectCoins" do
     prop "sufficient collateral is selected if possible" \(SomeTxConstraints marloweVersion constraints) -> do
@@ -242,7 +254,7 @@ spec = do
       -- - Looking for a pure ADA utxo that's 2x the fee (protocol maximum fee)
       -- - If it's selecting collat that has a native token, that's failure, not supposed to do that
 
-      marloweContext <- genSimpleMarloweContext marloweVersion constraints
+      marloweContext <- genSimpleScriptContext marloweVersion constraints
 
       (executesPlutusScript, txBodyContent) <-
         frequency
@@ -482,7 +494,7 @@ spec = do
           else noCollateralUnlessPlutus
 
     prop "selectCoins should increase the number of outputs by either 0 or exactly 1" \(SomeTxConstraints marloweVersion constraints) -> do
-      marloweContext <- genSimpleMarloweContext marloweVersion constraints
+      scriptCtx <- genSimpleScriptContext marloweVersion constraints
       walletContext <- genWalletWithNuisance marloweVersion constraints 1_000_000_000
       txBodyContentBefore <- genBodyContentWith500AdaOutput
 
@@ -505,7 +517,7 @@ spec = do
                 ReferenceTxInsScriptsInlineDatumsInBabbageEra
                 protocolTestnet
                 marloweVersion
-                marloweContext
+                scriptCtx
                 walletContext
                 txBodyContentBefore
 
@@ -519,7 +531,7 @@ spec = do
         Left selFailedMsg -> counterexample ("selection failed: " <> selFailedMsg) False
 
     prop "selectCoins creates a balanceable tx" \(SomeTxConstraints marloweVersion constraints) -> do
-      marloweContext <- genSimpleMarloweContext marloweVersion constraints
+      scriptCtx <- genSimpleScriptContext marloweVersion constraints
       walletContext <- genWalletWithNuisance marloweVersion constraints 1_000_000_000
       txBodyContentBefore <- genBodyContentWith500AdaOutput
 
@@ -598,7 +610,7 @@ spec = do
                 ReferenceTxInsScriptsInlineDatumsInBabbageEra
                 protocolTestnet
                 marloweVersion
-                marloweContext
+                scriptCtx
                 walletContext
                 txBodyContentBefore
 
@@ -635,7 +647,7 @@ spec = do
       inValue <- hedgehog genValueForTxOut
       case findMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (inAddress, inDatum, inValue) of
         Right outValue -> pure $ valueToLovelace outValue `shouldSatisfy` isJust
-        Left message -> pure . expectationFailure $ show (message :: ConstraintError 'V1)
+        Left message -> pure . expectationFailure $ show (message :: ConstraintError)
     prop "minUTxO matches Cardano API" do
       inAddress <- arbitrary
       inDatum <- oneof [pure Nothing, Just <$> hedgehog genScriptData]
@@ -660,7 +672,7 @@ spec = do
                 )
                 protocolTestnet
           outValue <-
-            first (\message -> show (message :: ConstraintError 'V1)) $
+            first (\message -> show (message :: ConstraintError)) $
               findMinUtxo
                 ReferenceTxInsScriptsInlineDatumsInBabbageEra
                 protocolTestnet
@@ -674,13 +686,13 @@ spec = do
       inValue <- hedgehog genValueForTxOut
       case ensureMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (inAddress, inValue) of
         Right (_, outValue) -> pure $ noLovelace outValue `shouldBe` noLovelace inValue
-        Left message -> pure . expectationFailure $ show (message :: ConstraintError 'V1)
+        Left message -> pure . expectationFailure $ show (message :: ConstraintError)
     prop "address is unchanged" do
       inAddress <- arbitrary
       inValue <- hedgehog genValueForTxOut
       case ensureMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (inAddress, inValue) of
         Right (outAddress, _) -> pure $ outAddress `shouldBe` inAddress
-        Left message -> pure . expectationFailure $ show (message :: ConstraintError 'V1)
+        Left message -> pure . expectationFailure $ show (message :: ConstraintError)
     prop "adjusted lovelace is greater of minUTxO and original lovelace" do
       inAddress <- arbitrary
       -- Tiny lovelace values violate ledger rules and occupy too few bytes for a meaningful test.
@@ -699,13 +711,13 @@ spec = do
                 (TxOut inAddress' (TxOutValue MultiAssetInBabbageEra inValue) TxOutDatumNone ReferenceScriptNone)
                 protocolTestnet
           (_, outValue) <-
-            first (\message -> show (message :: ConstraintError 'V1)) $
+            first (\message -> show (message :: ConstraintError)) $
               ensureMinUtxo ReferenceTxInsScriptsInlineDatumsInBabbageEra protocolTestnet (inAddress, inValue)
           pure $ selectLovelace outValue `shouldBe` maximum [selectLovelace inValue, selectLovelace expected]
 
   describe "balanceTx" do
     prop "tx should balance for non-Plutus transactions where the wallet has sufficient funds" \(SomeTxConstraints marloweVersion constraints) -> do
-      marloweContext <- genSimpleMarloweContext marloweVersion constraints
+      scriptCtx <- genSimpleScriptContext marloweVersion constraints
 
       -- We MUST dictate the distribution of wallet context assets, default
       -- generation only tests with empty wallets!
@@ -817,7 +829,7 @@ spec = do
         eraHistory
         protocolTestnet
         marloweVersion
-        marloweContext
+        scriptCtx
         walletContext
         txBodyContent of
         Right _ -> label "balancing succeeded" True
@@ -906,16 +918,23 @@ txOutToValue :: TxOut CtxTx BabbageEra -> Value
 txOutToValue (TxOut _ value _ _) = txOutValueToValue value
 
 -- A simple Marlowe context with no assets to spend
-genSimpleMarloweContext :: MarloweVersion v -> TxConstraints BabbageEra v -> Gen (MarloweContext w)
-genSimpleMarloweContext marloweVersion constraints = do
+genSimpleScriptContext
+  :: MarloweVersion v -> TxConstraints BabbageEra v -> Gen (Either (MarloweContext w) PayoutContext)
+genSimpleScriptContext marloweVersion constraints = do
   -- Let the generator make us one..
-  mctx <- genMarloweContext marloweVersion constraints
+  ctx <- genScriptContext marloweVersion constraints
   -- ..and hack these values to be empty/nothing
-  pure $
-    mctx
-      { scriptOutput = Nothing
-      , payoutOutputs = Map.empty
-      }
+  pure case ctx of
+    Left ctx' ->
+      Left
+        ctx'
+          { scriptOutput = Nothing
+          }
+    Right ctx' ->
+      Right
+        ctx'
+          { payoutOutputs = mempty
+          }
 
 -- Convenience function to build a chain Assets with the specified amount of only ADA
 mkAdaOnlyAssets :: Integer -> Chain.Assets
@@ -973,22 +992,34 @@ emptyTxBodyContent =
 
 violations
   :: MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> Chain.UTxOs
   -> TxConstraints BabbageEra v
   -> TxBodyContent BuildTx BabbageEra
   -> [String]
-violations marloweVersion marloweContext utxos constraints txBodyContent =
+violations marloweVersion scriptCtx utxos constraints txBodyContent =
   fold
     [ ("mustMintRoleToken: " <>) <$> mustMintRoleTokenViolations marloweVersion constraints txBodyContent
     , ("mustSpendRoleToken: " <>) <$> mustSpendRoleTokenViolations marloweVersion utxos constraints txBodyContent
     , ("mustPayToAddress: " <>) <$> mustPayToAddressViolations marloweVersion constraints txBodyContent
-    , ("mustSendMarloweOutput: " <>)
-        <$> mustSendMarloweOutputViolations marloweVersion marloweContext constraints txBodyContent
-    , ("mustPayToRole: " <>) <$> mustPayToRoleViolations marloweVersion marloweContext constraints txBodyContent
-    , ("mustConsumeMarloweOutput: " <>)
-        <$> mustConsumeMarloweOutputViolations marloweVersion marloweContext constraints txBodyContent
-    , ("mustConsumePayouts: " <>) <$> mustConsumePayoutsViolations marloweVersion marloweContext constraints txBodyContent
+    , case scriptCtx of
+        Left marloweContext ->
+          ("mustSendMarloweOutput: " <>)
+            <$> mustSendMarloweOutputViolations marloweVersion marloweContext constraints txBodyContent
+        _ -> []
+    , case scriptCtx of
+        Left marloweContext ->
+          ("mustPayToRole: " <>) <$> mustPayToRoleViolations marloweVersion marloweContext constraints txBodyContent
+        _ -> []
+    , case scriptCtx of
+        Left marloweContext ->
+          ("mustConsumeMarloweOutput: " <>)
+            <$> mustConsumeMarloweOutputViolations marloweVersion marloweContext constraints txBodyContent
+        _ -> []
+    , case scriptCtx of
+        Right payoutContext ->
+          ("mustConsumePayout: " <>) <$> mustConsumePayoutViolations marloweVersion payoutContext constraints txBodyContent
+        _ -> []
     , ("requiresSignature: " <>) <$> requiresSignatureViolations marloweVersion utxos constraints txBodyContent
     , ("requiresMetadata: " <>) <$> requiresMetadataViolations marloweVersion constraints txBodyContent
     ]
@@ -1178,25 +1209,32 @@ mustConsumeMarloweOutputViolations MarloweV1 MarloweContext{..} TxConstraints{..
             "Tx validity range does not match constraints"
         ]
 
-mustConsumePayoutsViolations
+mustConsumePayoutViolations
   :: MarloweVersion v
-  -> MarloweContext v
+  -> PayoutContext
   -> TxConstraints BabbageEra v
   -> TxBodyContent BuildTx BabbageEra
   -> [String]
-mustConsumePayoutsViolations MarloweV1 MarloweContext{..} TxConstraints{..} TxBodyContent{..} = do
-  roleToken <- Set.toList payoutInputConstraints
-  (("roleToken" <> show roleToken <> ": ") <>) <$> do
-    let isMatch (_, witness) = case witness of
-          BuildTxWith (ScriptWitness _ (PlutusScriptWitness _ _ _ (ScriptDatumForTxIn d) _ _)) ->
-            d == toCardanoScriptData (toChainPayoutDatum MarloweV1 roleToken)
+mustConsumePayoutViolations MarloweV1 PayoutContext{..} TxConstraints{..} TxBodyContent{..} = do
+  payout <- Set.toList payoutInputConstraints
+  (("payout " <> T.unpack (renderTxOutRef payout) <> ": ") <>) <$> do
+    let isMatch (txIn, _) = fromCardanoTxIn txIn == payout
+        matchingInput = find isMatch txIns
+        isReferenceScript = \case
+          PReferenceScript _ _ -> True
           _ -> False
-        matchingInputs = fromCardanoTxIn . fst <$> filter isMatch txIns
-        isPayoutUtxo utxo = Map.member utxo payoutOutputs
-    fold
-      [ check (not $ null matchingInputs) "No matching inputs found"
-      , check (all isPayoutUtxo matchingInputs) "Not all matching inputs come from the payout address"
-      ]
+    case matchingInput of
+      Nothing -> ["No matching inputs found"]
+      Just (_, BuildTxWith (ScriptWitness _ (PlutusScriptWitness _ _ s (ScriptDatumForTxIn d) _ _))) ->
+        case Map.lookup payout payoutOutputs of
+          Nothing -> ["Not found in context"]
+          Just Chain.TransactionOutput{datum = Just expectedDatum} ->
+            fold
+              [ check (isReferenceScript s) $ "Non-reference script: " <> show s
+              , check (fromCardanoScriptData d == expectedDatum) $ "Non-reference script: " <> show s
+              ]
+          _ -> ["Payout has no datum!"]
+      Just (_, wit) -> ["Non-plutus-script witness: " <> show wit]
 
 requiresSignatureViolations
   :: MarloweVersion v
@@ -1243,7 +1281,8 @@ instance Show SomeTxConstraints where
 instance Arbitrary SomeTxConstraints where
   arbitrary =
     oneof
-      [ SomeTxConstraints MarloweV1 <$> genV1Constraints
+      [ SomeTxConstraints MarloweV1 <$> genV1MarloweConstraints
+      , SomeTxConstraints MarloweV1 <$> genV1PayoutConstraints
       ]
   shrink (SomeTxConstraints marloweVersion constraints) =
     case marloweVersion of
@@ -1292,10 +1331,10 @@ shrinkMarloweOutputConstraints = \case
       , [MarloweOutput assets datum' | datum' <- shrink datum]
       ]
 
-genV1Constraints :: Gen (TxConstraints BabbageEra 'V1)
-genV1Constraints = sized \n ->
+genV1MarloweConstraints :: Gen (TxConstraints BabbageEra 'V1)
+genV1MarloweConstraints = sized \n ->
   frequency
-    [ (n, resize (n `div` 2) $ (<>) <$> genV1Constraints <*> genV1Constraints)
+    [ (n, resize (n `div` 2) $ (<>) <$> genV1MarloweConstraints <*> genV1MarloweConstraints)
     , (1, pure mempty)
     , (1, mustMintRoleToken <$> arbitrary <*> genMintScriptWitness <*> genRoleToken <*> arbitrary)
     , (1, mustSpendRoleToken <$> genRoleToken)
@@ -1303,7 +1342,18 @@ genV1Constraints = sized \n ->
     , (1, mustSendMarloweOutput <$> arbitrary <*> genDatum)
     , (1, mustPayToRole <$> arbitrary <*> genRoleToken)
     , (1, uncurry mustConsumeMarloweOutput <$> genValidityInterval <*> genInputs)
-    , (1, mustConsumePayouts <$> genRoleToken)
+    , (1, requiresSignature <$> arbitrary)
+    , (1, requiresMetadata <$> arbitrary)
+    ]
+
+genV1PayoutConstraints :: Gen (TxConstraints BabbageEra 'V1)
+genV1PayoutConstraints = sized \n ->
+  frequency
+    [ (n, resize (n `div` 2) $ (<>) <$> genV1PayoutConstraints <*> genV1PayoutConstraints)
+    , (1, pure mempty)
+    , (1, mustSpendRoleToken <$> genRoleToken)
+    , (1, mustPayToAddress <$> arbitrary <*> arbitrary)
+    , (1, mustConsumePayout <$> arbitrary)
     , (1, requiresSignature <$> arbitrary)
     , (1, requiresMetadata <$> arbitrary)
     ]
@@ -1378,25 +1428,38 @@ genRole =
     , "applicant"
     ]
 
-genMarloweContext :: MarloweVersion v -> TxConstraints BabbageEra v -> Gen (MarloweContext v)
-genMarloweContext MarloweV1 constraints = do
-  marloweScriptHash <- hedgehog genScriptHash
-  payoutScriptHash <- hedgehog genScriptHash
-  let scriptAddress hash =
-        fromCardanoAddressAny $
-          AddressShelley $
-            makeShelleyAddress Mainnet (PaymentCredentialByScript hash) NoStakeAddress
-      marloweAddress = scriptAddress marloweScriptHash
-      payoutAddress = scriptAddress payoutScriptHash
-  MarloweContext
-    <$> genScriptOutput marloweAddress constraints
-    <*> genPayoutOutputs payoutAddress constraints
-    <*> pure marloweAddress
-    <*> pure payoutAddress
-    <*> genReferenceScriptUtxo marloweAddress
-    <*> genReferenceScriptUtxo payoutAddress
-    <*> pure (fromCardanoScriptHash marloweScriptHash)
-    <*> pure (fromCardanoScriptHash payoutScriptHash)
+genScriptContext :: MarloweVersion v -> TxConstraints BabbageEra v -> Gen (Either (MarloweContext v) PayoutContext)
+genScriptContext MarloweV1 constraints
+  | Set.null (payoutInputConstraints constraints) =
+      Left <$> do
+        marloweScriptHash <- hedgehog genScriptHash
+        payoutScriptHash <- hedgehog genScriptHash
+        let scriptAddress hash =
+              fromCardanoAddressAny $
+                AddressShelley $
+                  makeShelleyAddress Mainnet (PaymentCredentialByScript hash) NoStakeAddress
+            marloweAddress = scriptAddress marloweScriptHash
+            payoutAddress = scriptAddress payoutScriptHash
+        MarloweContext
+          <$> genScriptOutput marloweAddress constraints
+          <*> pure marloweAddress
+          <*> pure payoutAddress
+          <*> genReferenceScriptUtxo marloweAddress
+          <*> genReferenceScriptUtxo payoutAddress
+          <*> pure (fromCardanoScriptHash marloweScriptHash)
+          <*> pure (fromCardanoScriptHash payoutScriptHash)
+  | otherwise =
+      Right <$> do
+        scriptHashes <- listOf1 $ hedgehog genScriptHash
+        let scriptAddress hash =
+              fromCardanoAddressAny $
+                AddressShelley $
+                  makeShelleyAddress Mainnet (PaymentCredentialByScript hash) NoStakeAddress
+            scriptAddresses = (fromCardanoScriptHash &&& scriptAddress) <$> scriptHashes
+        payoutScriptOutputs <- Map.fromList <$> for scriptAddresses \a -> (fst a,) <$> genReferenceScriptUtxo (snd a)
+        PayoutContext
+          <$> genPayoutOutputs (snd <$> scriptAddresses) constraints
+          <*> pure payoutScriptOutputs
 
 genScriptOutput :: Chain.Address -> TxConstraints BabbageEra 'V1 -> Gen (Maybe (TransactionScriptOutput 'V1))
 genScriptOutput address TxConstraints{..} = case marloweInputConstraints of
@@ -1407,31 +1470,27 @@ genScriptOutput address TxConstraints{..} = case marloweInputConstraints of
       ]
   MarloweInput{} -> Just <$> (TransactionScriptOutput address <$> arbitrary <*> arbitrary <*> genDatum)
 
-genPayoutOutputs :: Chain.Address -> TxConstraints BabbageEra 'V1 -> Gen (Map Chain.TxOutRef (Payout 'V1))
-genPayoutOutputs address TxConstraints{..} = (<>) <$> required <*> extra
+genPayoutOutputs :: [Chain.Address] -> TxConstraints BabbageEra 'V1 -> Gen (Map Chain.TxOutRef Chain.TransactionOutput)
+genPayoutOutputs genAddress TxConstraints{..} = (<>) <$> required <*> arbitrary
   where
-    required = Map.fromList <$> traverse (genPayout address) (Set.toList payoutInputConstraints)
-    extra = Map.fromList <$> listOf (genPayout address =<< genRoleToken)
-
-genPayout :: Chain.Address -> Chain.AssetId -> Gen (Chain.TxOutRef, Payout 'V1)
-genPayout address datum = do
-  assets <- arbitrary
-  (,Payout{..}) <$> arbitrary
+    required =
+      Map.fromList <$> for (Set.toList payoutInputConstraints) \payout ->
+        (payout,) <$> genTransactionOutput (elements genAddress) (Just . toChainPayoutDatum MarloweV1 <$> genRoleToken)
 
 genReferenceScriptUtxo :: Chain.Address -> Gen ReferenceScriptUtxo
 genReferenceScriptUtxo address =
   ReferenceScriptUtxo
     <$> arbitrary
-    <*> genTransactionOutput (pure address)
+    <*> genTransactionOutput (pure address) (pure Nothing)
     <*> hedgehog (genPlutusScript PlutusScriptV2)
 
-genTransactionOutput :: Gen Chain.Address -> Gen Chain.TransactionOutput
-genTransactionOutput address =
+genTransactionOutput :: Gen Chain.Address -> Gen (Maybe Chain.Datum) -> Gen Chain.TransactionOutput
+genTransactionOutput address genTxOutDatum =
   Chain.TransactionOutput
     <$> address
     <*> arbitrary
     <*> pure Nothing
-    <*> pure Nothing
+    <*> genTxOutDatum
 
 genWalletContext :: MarloweVersion v -> TxConstraints BabbageEra v -> Gen WalletContext
 genWalletContext MarloweV1 constraints =
@@ -1445,17 +1504,17 @@ genWalletUtxos TxConstraints{..} = (<>) <$> required <*> extra
   where
     required = case roleTokenConstraints of
       RoleTokenConstraintsNone -> pure mempty
-      MintRoleTokens txOutRef _ _ -> Chain.UTxOs . Map.singleton txOutRef <$> genTransactionOutput arbitrary
+      MintRoleTokens txOutRef _ _ -> Chain.UTxOs . Map.singleton txOutRef <$> genTransactionOutput arbitrary (pure Nothing)
       SpendRoleTokens roleTokens ->
         fold <$> for (Set.toList roleTokens) \roleToken -> do
           txOutRef <- arbitrary
-          txOut <- genTransactionOutput arbitrary
+          txOut <- genTransactionOutput arbitrary (pure Nothing)
           let roleTokenAssets = Chain.Assets 0 $ Chain.Tokens $ Map.singleton roleToken 1
           pure $ Chain.UTxOs $ Map.singleton txOutRef $ txOut{Chain.assets = Chain.assets txOut <> roleTokenAssets}
     extra =
       fold <$> listOf do
         txOutRef <- arbitrary
-        txOut <- genTransactionOutput arbitrary
+        txOut <- genTransactionOutput arbitrary (pure Nothing)
         pure $ Chain.UTxOs $ Map.singleton txOutRef txOut
 
 toCardanoAssetId :: Chain.AssetId -> AssetId
diff --git a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/SafetySpec.hs b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/SafetySpec.hs
index 4d17442fed..38f4591967 100644
--- a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/SafetySpec.hs
+++ b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/SafetySpec.hs
@@ -264,7 +264,6 @@ spec =
           marloweContext =
             MarloweContext
               { scriptOutput = Nothing
-              , payoutOutputs = mempty
               , marloweAddress =
                   Chain.fromCardanoAddressInEra Cardano.BabbageEra
                     . Cardano.AddressInEra (Cardano.ShelleyAddressInEra Cardano.ShelleyBasedEraBabbage)
diff --git a/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs b/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
index f1c88bc21e..e9484c754b 100644
--- a/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
+++ b/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
@@ -105,6 +105,7 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   parseMetadataMap,
   parseMetadataText,
  )
+import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api
 import Language.Marlowe.Runtime.History.Api (ExtractCreationError, ExtractMarloweTransactionError)
 import Network.HTTP.Media (MediaType)
@@ -225,7 +226,7 @@ decodeRoleTokenMetadata = parseNFTMetadataDetails
     parseMetadataRecord = parseMetadataMap parseMetadataText Just
 
     parseSplittableText :: Metadata -> Maybe Text
-    parseSplittableText md = parseMetadataText md <|> (mconcat <$> parseMetadataList parseMetadataText md)
+    parseSplittableText md = parseMetadataText md <|> mconcat <$> parseMetadataList parseMetadataText md
 
 encodeRoleTokenMetadata :: RoleTokenMetadata -> Metadata
 encodeRoleTokenMetadata = encodeNFTMetadataDetails
@@ -505,7 +506,6 @@ instance Binary (WithdrawTx 'V1) where
 data WithdrawTxInEra era v = WithdrawTxInEra
   { version :: MarloweVersion v
   , inputs :: Map TxOutRef (Payout v)
-  , roleToken :: AssetId
   , txBody :: TxBody era
   }
 
@@ -513,21 +513,15 @@ deriving instance Show (WithdrawTxInEra BabbageEra 'V1)
 deriving instance Eq (WithdrawTxInEra BabbageEra 'V1)
 
 instance (IsShelleyBasedEra era) => Variations (WithdrawTxInEra era 'V1) where
-  variations =
-    WithdrawTxInEra MarloweV1
-      <$> variations
-        `varyAp` variations
-        `varyAp` variations
+  variations = WithdrawTxInEra MarloweV1 <$> variations `varyAp` variations
 
 instance (IsCardanoEra era) => Binary (WithdrawTxInEra era 'V1) where
   put WithdrawTxInEra{..} = do
     put inputs
-    put roleToken
     putTxBody txBody
   get = do
     let version = MarloweV1
     inputs <- get
-    roleToken <- get
     txBody <- getTxBody
     pure WithdrawTxInEra{..}
 
@@ -564,7 +558,7 @@ data MarloweTxCommand status err result where
     -- ^ Min Lovelace which should be used for the contract output.
     -> Either (Contract v) DatumHash
     -- ^ The contract to run, or the hash of the contract to load from the store.
-    -> MarloweTxCommand Void (CreateError v) (ContractCreated v)
+    -> MarloweTxCommand Void CreateError (ContractCreated v)
   -- | Construct a transaction that advances an active Marlowe contract by
   -- applying a sequence of inputs. The resulting, unsigned transaction can be
   -- signed via the cardano API or a wallet provider. When signed, the 'Submit'
@@ -586,24 +580,21 @@ data MarloweTxCommand status err result where
     -- is computed from the contract.
     -> Inputs v
     -- ^ The inputs to apply.
-    -> MarloweTxCommand Void (ApplyInputsError v) (InputsApplied v)
-  -- | Construct a transaction that withdraws available assets from an active
-  -- Marlowe contract for a set of roles in the contract. The resulting,
-  -- unsigned transaction can be signed via the cardano API or a wallet
-  -- provider. When signed, the 'Submit' command can be used to submit the
-  -- transaction to the attached Cardano node.
+    -> MarloweTxCommand Void ApplyInputsError (InputsApplied v)
+  -- | Construct a transaction that withdraws available assets from a set of
+  -- Marlowe contract payouts. The resulting, unsigned transaction can be signed
+  -- via the cardano API or a wallet provider. When signed, the 'Submit' command
+  -- can be used to submit the transaction to the attached Cardano node.
   Withdraw
     :: MarloweVersion v
     -- ^ The Marlowe version to use
     -> WalletAddresses
     -- ^ The wallet addresses to use when constructing the transaction
-    -> ContractId
-    -- ^ The ID of the contract to apply the inputs to.
-    -> TokenName
-    -- ^ The names of the roles whose assets to withdraw.
+    -> Set TxOutRef
+    -- ^ The payouts to withdraw.
     -> MarloweTxCommand
         Void
-        (WithdrawError v)
+        WithdrawError
         ( WithdrawTx v -- The unsigned tx body, to be signed by a wallet.
         )
   -- | Submits a signed transaction to the attached Cardano node.
@@ -629,9 +620,9 @@ instance OTelCommand MarloweTxCommand where
 
 instance Command MarloweTxCommand where
   data Tag MarloweTxCommand status err result where
-    TagCreate :: MarloweVersion v -> Tag MarloweTxCommand Void (CreateError v) (ContractCreated v)
-    TagApplyInputs :: MarloweVersion v -> Tag MarloweTxCommand Void (ApplyInputsError v) (InputsApplied v)
-    TagWithdraw :: MarloweVersion v -> Tag MarloweTxCommand Void (WithdrawError v) (WithdrawTx v)
+    TagCreate :: MarloweVersion v -> Tag MarloweTxCommand Void CreateError (ContractCreated v)
+    TagApplyInputs :: MarloweVersion v -> Tag MarloweTxCommand Void ApplyInputsError (InputsApplied v)
+    TagWithdraw :: MarloweVersion v -> Tag MarloweTxCommand Void WithdrawError (WithdrawTx v)
     TagSubmit :: Tag MarloweTxCommand SubmitStatus SubmitError BlockHeader
 
   data JobId MarloweTxCommand stats err result where
@@ -640,7 +631,7 @@ instance Command MarloweTxCommand where
   tagFromCommand = \case
     Create _ version _ _ _ _ _ -> TagCreate version
     ApplyInputs version _ _ _ _ _ _ -> TagApplyInputs version
-    Withdraw version _ _ _ -> TagWithdraw version
+    Withdraw version _ _ -> TagWithdraw version
     Submit _ _ -> TagSubmit
 
   tagFromJobId = \case
@@ -701,10 +692,9 @@ instance Command MarloweTxCommand where
       maybe (putWord8 0) (\t -> putWord8 1 *> put t) invalidBefore
       maybe (putWord8 0) (\t -> putWord8 1 *> put t) invalidHereafter
       putInputs version redeemer
-    Withdraw _ walletAddresses contractId tokenName -> do
+    Withdraw _ walletAddresses payoutIds -> do
       put walletAddresses
-      put contractId
-      put tokenName
+      put payoutIds
     Submit era tx -> case era of
       ReferenceTxInsScriptsInlineDatumsInBabbageEra -> do
         putWord8 0
@@ -717,8 +707,7 @@ instance Command MarloweTxCommand where
       roles <- get
       metadata <- get
       minAda <- get
-      contract <- get
-      pure $ Create mStakeCredential MarloweV1 walletAddresses roles metadata minAda contract
+      Create mStakeCredential MarloweV1 walletAddresses roles metadata minAda <$> get
     TagApplyInputs version -> do
       walletAddresses <- get
       contractId <- get
@@ -737,9 +726,7 @@ instance Command MarloweTxCommand where
       pure $ ApplyInputs version walletAddresses contractId metadata invalidBefore invalidHereafter redeemer
     TagWithdraw version -> do
       walletAddresses <- get
-      contractId <- get
-      tokenName <- get
-      pure $ Withdraw version walletAddresses contractId tokenName
+      Withdraw version walletAddresses <$> get
     TagSubmit -> do
       eraTag <- getWord8
       case eraTag of
@@ -804,27 +791,34 @@ data WalletAddresses = WalletAddresses
   deriving (Eq, Show, Generic, Binary, ToJSON, Variations)
 
 -- | Errors that can occur when trying to solve the constraints.
-data ConstraintError v
+data ConstraintError
   = MintingUtxoNotFound TxOutRef
   | RoleTokenNotFound AssetId
   | ToCardanoError
   | MissingMarloweInput
-  | PayoutInputNotFound (PayoutDatum v)
+  | PayoutNotFound TxOutRef
+  | InvalidPayoutDatum TxOutRef (Maybe Chain.Datum)
+  | InvalidPayoutScriptAddress TxOutRef Address
   | CalculateMinUtxoFailed String
   | CoinSelectionFailed String
   | BalancingError String
+  | MarloweInputInWithdraw
+  | MarloweOutputInWithdraw
+  | PayoutOutputInWithdraw
+  | PayoutInputInCreateOrApply
+  | UnknownPayoutScript ScriptHash
   deriving (Generic)
 
-deriving instance Eq (ConstraintError 'V1)
-deriving instance Ord (ConstraintError 'V1)
-deriving instance Show (ConstraintError 'V1)
-deriving instance Binary (ConstraintError 'V1)
-deriving instance Variations (ConstraintError 'V1)
-deriving instance ToJSON (ConstraintError 'V1)
+deriving instance Eq ConstraintError
+deriving instance Ord ConstraintError
+deriving instance Show ConstraintError
+deriving instance Binary ConstraintError
+deriving instance Variations ConstraintError
+deriving instance ToJSON ConstraintError
 
-data CreateError v
+data CreateError
   = CreateEraUnsupported AnyCardanoEra
-  | CreateConstraintError (ConstraintError v)
+  | CreateConstraintError ConstraintError
   | CreateLoadMarloweContextFailed LoadMarloweContextError
   | CreateBuildupFailed CreateBuildupError
   | CreateToCardanoError
@@ -832,12 +826,12 @@ data CreateError v
   | CreateContractNotFound
   deriving (Generic)
 
-deriving instance Eq (CreateError 'V1)
-deriving instance Show (CreateError 'V1)
-deriving instance Ord (CreateError 'V1)
-instance Binary (CreateError 'V1)
-instance Variations (CreateError 'V1)
-instance ToJSON (CreateError 'V1)
+deriving instance Eq CreateError
+deriving instance Show CreateError
+deriving instance Ord CreateError
+instance Binary CreateError
+instance Variations CreateError
+instance ToJSON CreateError
 
 data CreateBuildupError
   = MintingUtxoSelectionFailed
@@ -846,9 +840,9 @@ data CreateBuildupError
   deriving (Eq, Ord, Show, Generic)
   deriving anyclass (Binary, ToJSON, Variations)
 
-data ApplyInputsError v
+data ApplyInputsError
   = ApplyInputsEraUnsupported AnyCardanoEra
-  | ApplyInputsConstraintError (ConstraintError v)
+  | ApplyInputsConstraintError ConstraintError
   | ScriptOutputNotFound
   | ApplyInputsLoadMarloweContextFailed LoadMarloweContextError
   | ApplyInputsConstraintsBuildupFailed ApplyInputsConstraintsBuildupError
@@ -857,11 +851,11 @@ data ApplyInputsError v
   | ValidityLowerBoundTooHigh SlotNo SlotNo
   deriving (Generic)
 
-deriving instance Eq (ApplyInputsError 'V1)
-deriving instance Show (ApplyInputsError 'V1)
-instance Binary (ApplyInputsError 'V1)
-instance Variations (ApplyInputsError 'V1)
-instance ToJSON (ApplyInputsError 'V1)
+deriving instance Eq ApplyInputsError
+deriving instance Show ApplyInputsError
+instance Binary ApplyInputsError
+instance Variations ApplyInputsError
+instance ToJSON ApplyInputsError
 
 data ApplyInputsConstraintsBuildupError
   = MarloweComputeTransactionFailed String
@@ -869,18 +863,17 @@ data ApplyInputsConstraintsBuildupError
   deriving (Eq, Show, Generic)
   deriving anyclass (Binary, Variations, ToJSON)
 
-data WithdrawError v
+data WithdrawError
   = WithdrawEraUnsupported AnyCardanoEra
-  | WithdrawConstraintError (ConstraintError v)
-  | WithdrawLoadMarloweContextFailed LoadMarloweContextError
+  | WithdrawConstraintError ConstraintError
   | UnableToFindPayoutForAGivenRole TokenName
   deriving (Generic)
 
-deriving instance Eq (WithdrawError 'V1)
-deriving instance Show (WithdrawError 'V1)
-instance Binary (WithdrawError 'V1)
-instance Variations (WithdrawError 'V1)
-instance ToJSON (WithdrawError 'V1)
+deriving instance Eq WithdrawError
+deriving instance Show WithdrawError
+instance Binary WithdrawError
+instance Variations WithdrawError
+instance ToJSON WithdrawError
 
 data LoadMarloweContextError
   = LoadMarloweContextErrorNotFound
@@ -922,11 +915,10 @@ instance CommandEq MarloweTxCommand where
           && invalidBefore == invalidBefore'
           && invalidHereafter == invalidHereafter'
           && inputs == inputs'
-    Withdraw MarloweV1 wallet contractId role -> \case
-      Withdraw MarloweV1 wallet' contractId' role' ->
+    Withdraw MarloweV1 wallet payoutIds -> \case
+      Withdraw MarloweV1 wallet' payoutIds' ->
         wallet == wallet'
-          && contractId == contractId'
-          && role == role'
+          && payoutIds == payoutIds'
     Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra tx -> \case
       Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra tx' -> tx == tx'
 
@@ -1013,16 +1005,14 @@ instance ShowCommand MarloweTxCommand where
             . showSpace
             . showsPrec 11 inputs
         )
-      Withdraw MarloweV1 wallet contractId role ->
+      Withdraw MarloweV1 wallet payoutIds ->
         ( showString "Withdraw"
             . showSpace
             . showsPrec 11 MarloweV1
             . showSpace
             . showsPrec 11 wallet
             . showSpace
-            . showsPrec 11 contractId
-            . showSpace
-            . showsPrec 11 role
+            . showsPrec 11 payoutIds
         )
       Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra tx ->
         ( showString "Submit"
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction.hs
index dacabe7100..a3203aecbb 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction.hs
@@ -31,8 +31,8 @@ import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..), renderContractId)
 import Language.Marlowe.Runtime.Core.ScriptRegistry (MarloweScripts, ReferenceScriptUtxo (..))
 import Language.Marlowe.Runtime.Transaction.Api (MarloweTxCommand)
 import Language.Marlowe.Runtime.Transaction.Chain
-import Language.Marlowe.Runtime.Transaction.Constraints (MarloweContext (..), WalletContext (..))
-import Language.Marlowe.Runtime.Transaction.Query (LoadMarloweContext, LoadWalletContext)
+import Language.Marlowe.Runtime.Transaction.Constraints (MarloweContext (..), PayoutContext (..), WalletContext (..))
+import Language.Marlowe.Runtime.Transaction.Query (LoadMarloweContext, LoadPayoutContext, LoadWalletContext)
 import qualified Language.Marlowe.Runtime.Transaction.Query as Q
 import Language.Marlowe.Runtime.Transaction.Server
 import Language.Marlowe.Runtime.Transaction.Submit (SubmitJob)
@@ -48,6 +48,7 @@ data TransactionDependencies m = TransactionDependencies
   { chainSyncConnector :: Connector RuntimeChainSeekClient m
   , mkSubmitJob :: forall era. ScriptDataSupportedInEra era -> Tx era -> STM (SubmitJob m)
   , loadWalletContext :: LoadWalletContext m
+  , loadPayoutContext :: LoadPayoutContext m
   , loadMarloweContext :: LoadMarloweContext m
   , chainSyncQueryConnector :: Connector (QueryClient ChainSyncQuery) m
   , contractQueryConnector :: Connector (QueryClient ContractRequest) m
@@ -144,6 +145,29 @@ renderLoadWalletContextSelectorOTel = \case
               ]
       }
 
+renderLoadPayoutContextSelectorOTel :: RenderSelectorOTel Q.LoadPayoutContextSelector
+renderLoadPayoutContextSelectorOTel = \case
+  Q.LoadPayoutContext ->
+    OTelRendered
+      { eventName = "marlowe_tx/load_wallet_context"
+      , eventKind = Client
+      , renderField = \case
+          Q.ForPayouts payouts -> [("marlowe.tx.payouts", toAttribute $ renderTxOutRef <$> Set.toList payouts)]
+          Q.PayoutContextLoaded PayoutContext{..} ->
+            catMaybes
+              [ Just
+                  ( "marlowe.contract_payout_utxo"
+                  , toAttribute $
+                      fmap renderTxOutRef $
+                        Map.keys payoutOutputs
+                  )
+              , Just
+                  ( "marlowe.payout_reference_script_outputs"
+                  , toAttribute $ renderTxOutRef . txOutRef <$> Map.elems payoutScriptOutputs
+                  )
+              ]
+      }
+
 renderLoadMarloweContextSelectorOTel :: RenderSelectorOTel Q.LoadMarloweContextSelector
 renderLoadMarloweContextSelectorOTel = \case
   Q.LoadMarloweContext ->
@@ -188,12 +212,6 @@ renderLoadMarloweContextSelectorOTel = \case
       , renderField = \MarloweContext{..} ->
           catMaybes
             [ ("marlowe.contract_utxo",) . fromString . show <$> scriptOutput
-            , Just
-                ( "marlowe.contract_payout_utxo"
-                , toAttribute $
-                    fmap renderTxOutRef $
-                      Map.keys payoutOutputs
-                )
             , ("marlowe.marlowe_script_address",) . toAttribute <$> toBech32 marloweAddress
             , ("marlowe.payout_script_address",) . toAttribute <$> toBech32 payoutAddress
             , Just case marloweScriptUTxO of
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
index 535da80475..e2b25e1e7c 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
@@ -24,8 +24,10 @@ import Data.Foldable (for_, traverse_)
 import Data.Function (on)
 import Data.Functor ((<&>))
 import Data.List (find, sortBy)
+import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe, maybeToList)
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Time (UTCTime, nominalDiffTimeToSeconds, secondsToNominalDiffTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
@@ -55,6 +57,7 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   TokenName (..),
   TransactionMetadata (..),
   TransactionOutput (..),
+  TxOutRef,
   UTxO (UTxO),
   toUTxOsList,
   unInterpreter,
@@ -65,7 +68,9 @@ import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata (..),
   MarloweVersion (..),
   MarloweVersionTag (..),
+  Payout (..),
   TransactionScriptOutput (..),
+  fromChainPayoutDatum,
   withMarloweVersion,
  )
 import Language.Marlowe.Runtime.Plutus.V2.Api (
@@ -85,7 +90,7 @@ import Language.Marlowe.Runtime.Transaction.Api (
   CreateError (..),
   Mint (unMint),
   RoleTokensConfig (..),
-  WithdrawError,
+  WithdrawError (..),
   encodeRoleTokenMetadata,
  )
 import Language.Marlowe.Runtime.Transaction.Constraints (
@@ -151,7 +156,7 @@ buildCreateConstraints
   -- ^ Min Lovelace value which should be used on the Marlowe output.
   -> Contract v
   -- ^ The contract being instantiated.
-  -> Either (CreateError v) ((Datum v, Assets, PolicyId), TxConstraints era v)
+  -> Either CreateError ((Datum v, Assets, PolicyId), TxConstraints era v)
 buildCreateConstraints era version walletCtx roles metadata minAda contract = case version of
   MarloweV1 -> runTxConstraintsBuilder version $ buildCreateConstraintsV1 era walletCtx roles metadata minAda contract
 
@@ -171,7 +176,7 @@ buildCreateConstraintsV1
   -- ^ Min Lovelace value which should be used on the Marlowe output.
   -> Contract 'V1
   -- ^ The contract being instantiated.
-  -> TxConstraintsBuilderM (CreateError 'V1) era 'V1 (Datum 'V1, Assets, PolicyId)
+  -> TxConstraintsBuilderM CreateError era 'V1 (Datum 'V1, Assets, PolicyId)
 buildCreateConstraintsV1 era walletCtx roles metadata minAda contract = do
   -- Output constraints.
   -- Role tokens minting and distribution.
@@ -207,13 +212,13 @@ buildCreateConstraintsV1 era walletCtx roles metadata minAda contract = do
       tell $ mustSendMarloweOutput assets datum
       pure (datum, assets)
 
-    mkMarloweDatum :: PolicyId -> TxConstraintsBuilderM (CreateError 'V1) era 'V1 (Datum 'V1)
+    mkMarloweDatum :: PolicyId -> TxConstraintsBuilderM CreateError era 'V1 (Datum 'V1)
     mkMarloweDatum policyId = do
       marloweState <- mkInitialMarloweState
       let marloweParams = V1.MarloweParams . toPlutusCurrencySymbol $ policyId
       pure $ V1.MarloweData marloweParams marloweState contract
 
-    mkInitialMarloweState :: TxConstraintsBuilderM (CreateError 'V1) era 'V1 V1.State
+    mkInitialMarloweState :: TxConstraintsBuilderM CreateError era 'V1 V1.State
     mkInitialMarloweState = do
       let WalletContext{changeAddress = minAdaProvider} = walletCtx
       (net, addr) <- liftMaybe (AddressDecodingFailed minAdaProvider) do
@@ -237,7 +242,7 @@ buildCreateConstraintsV1 era walletCtx roles metadata minAda contract = do
     adaAsset amount = Assets amount mempty
 
     -- Role token distribution constraints
-    mintRoleTokens :: TxConstraintsBuilderM (CreateError 'V1) era 'V1 PolicyId
+    mintRoleTokens :: TxConstraintsBuilderM CreateError era 'V1 PolicyId
     mintRoleTokens = case roles of
       RoleTokensUsePolicy policyId -> pure policyId
       RoleTokensMint (unMint -> minting) -> do
@@ -310,7 +315,7 @@ buildApplyInputsConstraints
   -- in the contract.
   -> Inputs v
   -- ^ The inputs to apply to the contract.
-  -> ExceptT (ApplyInputsError v) m (ApplyResults v, TxConstraints era v)
+  -> ExceptT ApplyInputsError m (ApplyResults v, TxConstraints era v)
 buildApplyInputsConstraints merkleizeInputs systemStart eraHistory version marloweOutput tipSlot metadata invalidBefore invalidHereafter inputs =
   case version of
     MarloweV1 ->
@@ -345,7 +350,7 @@ buildApplyInputsConstraintsV1
   -- ^ The maximum bound of the validity interval (exclusive).
   -> Inputs 'V1
   -- ^ The inputs to apply to the contract.
-  -> ExceptT (ApplyInputsError 'V1) m (ApplyResults 'V1, TxConstraints era 'V1)
+  -> ExceptT ApplyInputsError m (ApplyResults 'V1, TxConstraints era 'V1)
 buildApplyInputsConstraintsV1 merkleizeInputs systemStart eraHistory marloweOutput tipSlot metadata invalidBefore invalidHereafter inputs = runWriterT do
   let TransactionScriptOutput _ _ _ datum = marloweOutput
       V1.MarloweData params state contract = datum
@@ -461,7 +466,7 @@ buildApplyInputsConstraintsV1 merkleizeInputs systemStart eraHistory marloweOutp
     EraHistory _ interpreter = eraHistory
 
     -- Calculate slot number which contains a given timestamp
-    utcTimeToSlotNo :: UTCTime -> ExceptT (ApplyInputsError 'V1) m C.SlotNo
+    utcTimeToSlotNo :: UTCTime -> ExceptT ApplyInputsError m C.SlotNo
     utcTimeToSlotNo = withExceptT (SlotConversionFailed . show) . except . utcTimeToSlotNo'
 
     -- Calculate slot number which contains a given timestamp
@@ -473,7 +478,7 @@ buildApplyInputsConstraintsV1 merkleizeInputs systemStart eraHistory marloweOutp
           wallclockToSlot relativeTime
       pure $ C.SlotNo $ O.unSlotNo slotNo
 
-    slotStart :: C.SlotNo -> ExceptT (ApplyInputsError 'V1) m UTCTime
+    slotStart :: C.SlotNo -> ExceptT ApplyInputsError m UTCTime
     slotStart (C.SlotNo slotNo) = do
       (relativeTime, _) <-
         except $
@@ -515,14 +520,27 @@ buildApplyInputsConstraintsV1 merkleizeInputs systemStart eraHistory marloweOutp
 -- | Creates a set of Tx constraints that are used to build a transaction that
 -- withdraws payments from a payout validator.
 buildWithdrawConstraints
-  :: MarloweVersion v
+  :: forall m era v
+   . (Monad m)
+  => TxConstraints.PayoutContext
+  -- ^ The payout context for the current transaction.
+  -> MarloweVersion v
   -- ^ The Marlowe version to build the transaction for.
-  -> PayoutDatum v
-  -- ^ The role token from which to withdraw funds.
-  -> Either (WithdrawError v) (TxConstraints era v)
-buildWithdrawConstraints = \case
-  MarloweV1 -> Right . buildWithdrawConstraintsV1
+  -> Set TxOutRef
+  -- ^ The payouts to withdraw
+  -> ExceptT WithdrawError m (Map TxOutRef (Payout v), TxConstraints era v)
+buildWithdrawConstraints TxConstraints.PayoutContext{..} = \case
+  MarloweV1 -> buildWithdrawConstraintsV1
   where
-    buildWithdrawConstraintsV1 :: AssetId -> TxConstraints era 'V1
-    buildWithdrawConstraintsV1 =
-      TxConstraints.mustConsumePayouts <> TxConstraints.mustSpendRoleToken
+    buildWithdrawConstraintsV1
+      :: Set TxOutRef -> ExceptT WithdrawError m (Map TxOutRef (Payout 'V1), TxConstraints era 'V1)
+    buildWithdrawConstraintsV1 payouts = runWriterT do
+      let payoutsList = Set.toAscList payouts
+      traverse_ (tell . TxConstraints.mustConsumePayout) payoutsList
+      Map.fromDistinctAscList <$> for payoutsList \payoutRef -> do
+        let notFoundError = WithdrawConstraintError $ TxConstraints.PayoutNotFound payoutRef
+        TransactionOutput{..} <- lift $ except $ note notFoundError $ Map.lookup payoutRef payoutOutputs
+        let invalidError = WithdrawConstraintError $ TxConstraints.InvalidPayoutDatum payoutRef datum
+        roleToken <- lift $ except $ note invalidError $ fromChainPayoutDatum MarloweV1 =<< datum
+        tell $ mustSpendRoleToken roleToken
+        pure (payoutRef, Payout address assets roleToken)
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Constraints.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Constraints.hs
index 62b0f1220b..72011816f0 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Constraints.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Constraints.hs
@@ -7,6 +7,7 @@
 module Language.Marlowe.Runtime.Transaction.Constraints (
   ConstraintError (..),
   MarloweContext (..),
+  PayoutContext (..),
   MarloweInputConstraints (..),
   MarloweOutputConstraints (..),
   RoleTokenConstraints (..),
@@ -18,7 +19,7 @@ module Language.Marlowe.Runtime.Transaction.Constraints (
   ensureMinUtxo,
   findMinUtxo,
   mustConsumeMarloweOutput,
-  mustConsumePayouts,
+  mustConsumePayout,
   mustMintRoleToken,
   mustPayToAddress,
   mustPayToRole,
@@ -36,20 +37,31 @@ import qualified Cardano.Api as C
 import qualified Cardano.Api.Shelley as C
 import Control.Applicative ((<|>))
 import Control.Error (note)
-import Control.Monad (forM, unless, when)
+import Control.Monad (forM, unless, when, (<=<))
 import Data.Aeson (ToJSON)
 import Data.Crosswalk (Crosswalk (sequenceL))
 import Data.Function (on)
 import Data.Functor ((<&>))
 import Data.List (delete, find, minimumBy, nub)
-import qualified Data.List.NonEmpty as NE (NonEmpty (..), toList)
 import Data.Map (Map)
-import qualified Data.Map as Map (elems, fromSet, keysSet, mapWithKey, member, null, singleton, toList, unionWith)
+import qualified Data.Map as Map (
+  elems,
+  fromSet,
+  keysSet,
+  lookup,
+  mapWithKey,
+  member,
+  null,
+  singleton,
+  toList,
+  unionWith,
+ )
 import qualified Data.Map.Strict as SMap (fromList, toList)
 import Data.Maybe (mapMaybe, maybeToList)
 import Data.Monoid (First (..), getFirst)
 import Data.Set (Set)
-import qualified Data.Set as Set (fromAscList, member, null, singleton, toAscList, toList, union)
+import qualified Data.Set as Set
+import Data.Traversable (for)
 import GHC.Generics (Generic)
 import qualified Language.Marlowe.Core.V1.Semantics.Types as V1
 import Language.Marlowe.Runtime.Cardano.Api (
@@ -67,7 +79,13 @@ import Language.Marlowe.Runtime.Cardano.Api (
   tokensToCardanoValue,
  )
 import Language.Marlowe.Runtime.Cardano.Feature (withShelleyBasedEra)
-import Language.Marlowe.Runtime.ChainSync.Api (lookupUTxO, toCardanoMetadata, toPlutusData, toUTxOTuple, toUTxOsList)
+import Language.Marlowe.Runtime.ChainSync.Api (
+  lookupUTxO,
+  toCardanoMetadata,
+  toPlutusData,
+  toUTxOTuple,
+  toUTxOsList,
+ )
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata (..),
@@ -75,18 +93,19 @@ import Language.Marlowe.Runtime.Core.Api (
   TransactionScriptOutput (utxo),
   emptyMarloweTransactionMetadata,
   encodeMarloweTransactionMetadata,
+  fromChainPayoutDatum,
  )
 import qualified Language.Marlowe.Runtime.Core.Api as Core
 import Language.Marlowe.Runtime.Core.ScriptRegistry (ReferenceScriptUtxo (..))
+import qualified Language.Marlowe.Runtime.Core.ScriptRegistry as ScriptRegistry
 import Language.Marlowe.Runtime.Transaction.Api (ConstraintError (..))
 import qualified Language.Marlowe.Scripts as V1
 import Ouroboros.Consensus.BlockchainTime (SystemStart)
-import Witherable (wither)
 
 -- | Describes a set of Marlowe-specific conditions that a transaction must satisfy.
 data TxConstraints era v = TxConstraints
   { marloweInputConstraints :: MarloweInputConstraints v
-  , payoutInputConstraints :: Set (Core.PayoutDatum v)
+  , payoutInputConstraints :: Set Chain.TxOutRef
   , roleTokenConstraints :: RoleTokenConstraints era
   , payToAddresses :: Map Chain.Address Chain.Assets
   , payToRoles :: Map (Core.PayoutDatum v) Chain.Assets
@@ -239,14 +258,15 @@ mustConsumeMarloweOutput :: (Core.IsMarloweVersion v) => C.SlotNo -> C.SlotNo ->
 mustConsumeMarloweOutput invalidBefore invalidHereafter inputs =
   mempty{marloweInputConstraints = MarloweInput invalidBefore invalidHereafter inputs}
 
--- | Require the transaction to consume any input from the payout script that
--- bear the given datum.
+-- | Require the transaction to consume the given payout transaction output.
 --
 -- Requires that:
---   1. At least one UTXO is consumed that bears the correct payout datum.
---   2. All such inputs that satisfy rule 1 come from the same address.
-mustConsumePayouts :: (Core.IsMarloweVersion v) => Core.PayoutDatum v -> TxConstraints era v
-mustConsumePayouts payoutDatum = mempty{payoutInputConstraints = Set.singleton payoutDatum}
+--   1. The output is consumed.
+--   2. The witness for the output is a script witness
+--   3. The script witness specifies a valid payout datum for the correct version
+--   4. The script witness specifies a reference script
+mustConsumePayout :: (Core.IsMarloweVersion v) => Chain.TxOutRef -> TxConstraints era v
+mustConsumePayout output = mempty{payoutInputConstraints = Set.singleton output}
 
 -- | Require the transaction to hold a signature for the given payment key
 -- hash.
@@ -311,12 +331,10 @@ data WalletContext = WalletContext
   }
   deriving (Show, Generic, ToJSON)
 
--- | Data from Marlowe Scripts needed to solve the constraints.
+-- | Data from Marlowe Script needed to solve the constraints.
 data MarloweContext v = MarloweContext
   { scriptOutput :: Maybe (Core.TransactionScriptOutput v)
   -- ^ The UTXO at the script address, if any.
-  , payoutOutputs :: Map Chain.TxOutRef (Core.Payout v)
-  -- ^ The UTXOs at the payout address.
   , marloweAddress :: Chain.Address
   , payoutAddress :: Chain.Address
   , marloweScriptUTxO :: ReferenceScriptUtxo
@@ -329,14 +347,23 @@ data MarloweContext v = MarloweContext
 deriving instance Show (MarloweContext 'V1)
 deriving instance ToJSON (MarloweContext 'V1)
 
+-- | Data from Payout Scripts needed to solve the constraints.
+data PayoutContext = PayoutContext
+  { payoutOutputs :: Map Chain.TxOutRef Chain.TransactionOutput
+  -- ^ The unspent payout outputs.
+  , payoutScriptOutputs :: Map Chain.ScriptHash ReferenceScriptUtxo
+  -- ^ The unspent payout reference script outputs indexed by script hash.
+  }
+  deriving (Generic, Show, Eq)
+
 type SolveConstraints =
   forall era v
    . C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> Core.MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> WalletContext
   -> TxConstraints era v
-  -> Either (ConstraintError v) (C.TxBody era)
+  -> Either ConstraintError (C.TxBody era)
 
 -- | Given a set of constraints and the context of a wallet, produces a
 -- balanced, unsigned transaction that satisfies the constraints.
@@ -345,12 +372,12 @@ solveConstraints
   -> C.EraHistory C.CardanoMode
   -> C.ProtocolParameters
   -> SolveConstraints
-solveConstraints start history protocol era version marloweCtx walletCtx constraints =
+solveConstraints start history protocol era version scriptCtx walletCtx constraints =
   withShelleyBasedEra era $
-    solveInitialTxBodyContent era protocol version marloweCtx walletCtx constraints
-      >>= adjustTxForMinUtxo era protocol (marloweAddress marloweCtx)
-      >>= selectCoins era protocol version marloweCtx walletCtx
-      >>= balanceTx era start history protocol version marloweCtx walletCtx
+    solveInitialTxBodyContent era protocol version scriptCtx walletCtx constraints
+      >>= adjustTxForMinUtxo era protocol (either (Just . marloweAddress) (const Nothing) scriptCtx)
+      >>= selectCoins era protocol version scriptCtx walletCtx
+      >>= balanceTx era start history protocol version scriptCtx walletCtx
 
 -- | 2022-08 This function was written to compensate for a bug in Cardano's
 --   calculateMinimumUTxO. It's called by adjustOutputForMinUTxO below. We will
@@ -367,12 +394,12 @@ ensureAtLeastHalfAnAda origValue =
 -- | Compute the `minAda` and adjust the lovelace in a single output to conform
 --   to the minimum ADA requirement.
 adjustOutputForMinUtxo
-  :: forall era v
+  :: forall era
    . (IsShelleyBasedEra era)
   => MultiAssetSupportedInEra era
   -> C.ProtocolParameters
   -> C.TxOut C.CtxTx era
-  -> Either (ConstraintError v) (C.TxOut C.CtxTx era)
+  -> Either ConstraintError (C.TxOut C.CtxTx era)
 adjustOutputForMinUtxo era protocol (C.TxOut address txOrigValue datum script) = do
   let origValue = C.txOutValueToValue txOrigValue
       adjustedForCalculateMin = ensureAtLeastHalfAnAda origValue
@@ -392,16 +419,17 @@ adjustOutputForMinUtxo era protocol (C.TxOut address txOrigValue datum script) =
 -- requirements. Additionally, ensures that the Value of the marlowe output
 -- does not change (fails with an error if it does).
 adjustTxForMinUtxo
-  :: forall era v
+  :: forall era
    . (IsShelleyBasedEra era)
   => C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> C.ProtocolParameters
-  -> Chain.Address
+  -> Maybe Chain.Address
   -> C.TxBodyContent C.BuildTx era
-  -> Either (ConstraintError v) (C.TxBodyContent C.BuildTx era)
-adjustTxForMinUtxo era protocol marloweAddress txBodyContent = do
+  -> Either ConstraintError (C.TxBodyContent C.BuildTx era)
+adjustTxForMinUtxo era protocol mMarloweAddress txBodyContent = do
   let getMarloweOutputValue :: [C.TxOut C.CtxTx era] -> Maybe (C.TxOutValue era)
-      getMarloweOutputValue =
+      getMarloweOutputValue outputs = do
+        marloweAddress <- mMarloweAddress
         getFirst
           . mconcat
           . map
@@ -412,6 +440,7 @@ adjustTxForMinUtxo era protocol marloweAddress txBodyContent = do
                         else Nothing
                   )
             )
+          $ outputs
 
       origTxOuts = C.txOuts txBodyContent
       origMarloweValue = getMarloweOutputValue origTxOuts
@@ -444,12 +473,12 @@ maximumFee C.ProtocolParameters{..} =
 --   the "none" reference script in order to use it with C.calculateMinimumUTxO
 --   in a subsequent call
 findMinUtxo
-  :: forall era v
+  :: forall era
    . (IsShelleyBasedEra era)
   => C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> C.ProtocolParameters
   -> (Chain.Address, Maybe Chain.Datum, C.Value)
-  -> Either (ConstraintError v) C.Value
+  -> Either ConstraintError C.Value
 findMinUtxo era protocol (chAddress, mbDatum, origValue) =
   do
     let atLeastHalfAnAda :: C.Value
@@ -479,12 +508,12 @@ findMinUtxo era protocol (chAddress, mbDatum, origValue) =
 
 -- | Ensure that the minimum UTxO requirement is satisfied for outputs.
 ensureMinUtxo
-  :: forall era v
+  :: forall era
    . (IsShelleyBasedEra era)
   => C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> C.ProtocolParameters
   -> (Chain.Address, C.Value)
-  -> Either (ConstraintError v) (Chain.Address, C.Value)
+  -> Either ConstraintError (Chain.Address, C.Value)
 ensureMinUtxo era protocol (chAddress, origValue) =
   case findMinUtxo era protocol (chAddress, Nothing, origValue) of
     Right minValue ->
@@ -503,7 +532,7 @@ makeTxOut
   -> C.TxOutDatum C.CtxTx era
   -> C.Value
   -> C.ReferenceScript era
-  -> Either (ConstraintError v) (C.TxOut C.CtxTx era)
+  -> Either ConstraintError (C.TxOut C.CtxTx era)
 makeTxOut era address datum value referenceScript = do
   cardanoAddress <-
     note
@@ -528,11 +557,11 @@ selectCoins
   => C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> C.ProtocolParameters
   -> Core.MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> WalletContext
   -> C.TxBodyContent C.BuildTx era
-  -> Either (ConstraintError v) (C.TxBodyContent C.BuildTx era)
-selectCoins era protocol marloweVersion marloweCtx walletCtx@WalletContext{..} txBodyContent = do
+  -> Either ConstraintError (C.TxBodyContent C.BuildTx era)
+selectCoins era protocol marloweVersion scriptCtx walletCtx@WalletContext{..} txBodyContent = do
   let -- Extract the value of a UTxO
       txOutToValue :: C.TxOut C.CtxTx era -> C.Value
       txOutToValue (C.TxOut _ value _ _) = C.txOutValueToValue value
@@ -540,7 +569,7 @@ selectCoins era protocol marloweVersion marloweCtx walletCtx@WalletContext{..} t
       -- All utxos that are spendable from either the Marlowe context or wallet context
       -- False means not including the reference utxo
       utxos :: [(C.TxIn, C.TxOut C.CtxTx era)]
-      utxos = allUtxos era marloweVersion marloweCtx walletCtx False
+      utxos = allUtxos era marloweVersion scriptCtx walletCtx False
 
       -- Compute the value of all available UTxOs
       universe :: C.Value
@@ -743,11 +772,11 @@ balanceTx
   -> C.EraHistory C.CardanoMode
   -> C.ProtocolParameters
   -> Core.MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> WalletContext
   -> C.TxBodyContent C.BuildTx era
-  -> Either (ConstraintError v) (C.TxBody era)
-balanceTx era systemStart eraHistory protocol marloweVersion marloweCtx walletCtx@WalletContext{..} C.TxBodyContent{..} = do
+  -> Either ConstraintError (C.TxBody era)
+balanceTx era systemStart eraHistory protocol marloweVersion scriptCtx walletCtx@WalletContext{..} C.TxBodyContent{..} = do
   changeAddress' <-
     maybe
       (Left $ BalancingError "Failed to convert change address.")
@@ -771,9 +800,7 @@ balanceTx era systemStart eraHistory protocol marloweVersion marloweCtx walletCt
       balancingLoop
         :: Integer
         -> C.Value
-        -> Either
-            (ConstraintError v)
-            (C.TxBodyContent C.BuildTx era, C.BalancedTxBody era)
+        -> Either ConstraintError (C.TxBodyContent C.BuildTx era, C.BalancedTxBody era)
       balancingLoop counter changeValue = do
         when (counter == 0) $
           Left . BalancingError $
@@ -805,7 +832,7 @@ balanceTx era systemStart eraHistory protocol marloweVersion marloweCtx walletCt
       -- FIXME: This only needs to be the subset of available UTxOs that are actually `TxIns`, but including extras should be harmless.
       -- This time we call allUtxos we need to know the total cost, so we do want the reference script (passing True)
       utxos :: C.UTxO era
-      utxos = C.UTxO . SMap.fromList $ allUtxos era marloweVersion marloweCtx walletCtx True
+      utxos = C.UTxO . SMap.fromList $ allUtxos era marloweVersion scriptCtx walletCtx True
 
       -- Compute net of inputs and outputs, accounting for minting.
       totalIn =
@@ -837,11 +864,11 @@ allUtxos
    . (IsCardanoEra era)
   => C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> Core.MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> WalletContext
   -> Bool -- False if we do not want to include the script reference
   -> [(C.TxIn, C.TxOut ctx era)]
-allUtxos era marloweVersion MarloweContext{..} WalletContext{..} includeReferences =
+allUtxos era marloweVersion scriptCtx WalletContext{..} includeReferences =
   let -- Convert chain UTxOs to Cardano API ones.
       multiAssetSupported :: C.MultiAssetSupportedInEra era
       multiAssetSupported = case era of
@@ -865,20 +892,6 @@ allUtxos era marloweVersion MarloweContext{..} WalletContext{..} includeReferenc
                   <*> pure C.ReferenceScriptNone
               )
 
-      mkPayoutUtxo :: (Chain.TxOutRef, Core.Payout v) -> Maybe (C.TxIn, C.TxOut ctx era)
-      mkPayoutUtxo (utxo, Core.Payout{..}) =
-        (,)
-          <$> toCardanoTxIn utxo
-          <*> ( C.TxOut
-                  <$> toCardanoAddressInEra C.cardanoEra address
-                  <*> toCardanoTxOutValue multiAssetSupported assets
-                  <*> pure
-                    ( C.TxOutDatumInline era . toCardanoScriptData $
-                        Core.toChainPayoutDatum marloweVersion datum
-                    )
-                  <*> pure C.ReferenceScriptNone
-              )
-
       -- Extra UTxOs for reference scripts.
       mkReferenceUtxo :: ReferenceScriptUtxo -> Maybe (C.TxIn, C.TxOut ctx era)
       mkReferenceUtxo ReferenceScriptUtxo{..} =
@@ -886,22 +899,26 @@ allUtxos era marloweVersion MarloweContext{..} WalletContext{..} includeReferenc
           <$> toCardanoTxIn txOutRef
           <*> toCardanoTxOut' multiAssetSupported txOut (Just . C.toScriptInAnyLang $ C.PlutusScript C.PlutusScriptV2 script)
    in mapMaybe convertUtxo (SMap.toList . Chain.unUTxOs $ availableUtxos)
-        <> maybe mempty pure (mkMarloweUtxo =<< scriptOutput)
-        <> mapMaybe mkPayoutUtxo (Map.toList payoutOutputs)
-        <> mapMaybe mkReferenceUtxo (filter (const includeReferences) [marloweScriptUTxO, payoutScriptUTxO])
+        <> either
+          (maybe mempty pure . (mkMarloweUtxo <=< scriptOutput))
+          (mapMaybe convertUtxo . Map.toList . payoutOutputs)
+          scriptCtx
+        <> mapMaybe
+          mkReferenceUtxo
+          (filter (const includeReferences) $ either (pure . marloweScriptUTxO) (Map.elems . payoutScriptOutputs) scriptCtx)
 
 solveInitialTxBodyContent
   :: forall era v
    . C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
   -> C.ProtocolParameters
   -> Core.MarloweVersion v
-  -> MarloweContext v
+  -> Either (MarloweContext v) PayoutContext
   -> WalletContext
   -> TxConstraints era v
-  -> Either (ConstraintError v) (C.TxBodyContent C.BuildTx era)
-solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletContext{..} TxConstraints{..} = do
-  txIns <- solveTxIns
-  txInsReference <- solveTxInsReference
+  -> Either ConstraintError (C.TxBodyContent C.BuildTx era)
+solveInitialTxBodyContent era protocol marloweVersion scriptCtx WalletContext{..} TxConstraints{..} = do
+  (txIns, requiredPayoutScriptHashes) <- solveTxIns
+  txInsReference <- solveTxInsReference requiredPayoutScriptHashes
   txOuts <- solveTxOuts
   txValidityRange <- solveTxValidityRange
   txExtraKeyWits <- solveTxExtraKeyWits
@@ -955,7 +972,7 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
     extraKeyWitnessesSupported = case era of
       C.ReferenceTxInsScriptsInlineDatumsInBabbageEra -> C.ExtraKeyWitnessesInBabbageEra
 
-    getWalletInputs :: Either (ConstraintError v) [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era))]
+    getWalletInputs :: Either ConstraintError [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era))]
     getWalletInputs = case roleTokenConstraints of
       RoleTokenConstraintsNone -> pure []
       MintRoleTokens txOutRef _ _ -> do
@@ -973,11 +990,10 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
             note ToCardanoError $ toCardanoTxIn txOutRef
         pure $ (,C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending) <$> txIns
 
-    getMarloweInput
-      :: Either (ConstraintError v) (Maybe (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era)))
-    getMarloweInput = case marloweInputConstraints of
-      MarloweInputConstraintsNone -> pure Nothing
-      MarloweInput _ _ inputs -> fmap Just $ do
+    getMarloweInput :: Either ConstraintError (Maybe (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era)))
+    getMarloweInput = case (marloweInputConstraints, scriptCtx) of
+      (MarloweInputConstraintsNone, _) -> pure Nothing
+      (MarloweInput _ _ inputs, Left MarloweContext{..}) -> fmap Just $ do
         Core.TransactionScriptOutput{..} <- note MissingMarloweInput scriptOutput
         txIn <- note ToCardanoError $ toCardanoTxIn utxo
         plutusScriptOrRefInput <-
@@ -1004,55 +1020,49 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
                 )
                 (C.ExecutionUnits 0 0)
         pure (txIn, C.BuildTxWith $ C.ScriptWitness C.ScriptWitnessForSpending scriptWitness)
-
-    getPayoutInputs :: Either (ConstraintError v) [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era))]
-    getPayoutInputs = do
-      let availableUtxoList = Map.toList payoutOutputs
-      foldMap NE.toList <$> forM (Set.toList payoutInputConstraints) \payoutDatum ->
-        note (PayoutInputNotFound payoutDatum) . toNonEmpty
-          =<< wither (maybeGetPayoutInput payoutDatum) availableUtxoList
-
-    -- Because Data.List.NonEmpty.fromList is a partial function(!)
-    toNonEmpty [] = Nothing
-    toNonEmpty (x : xs) = Just $ x NE.:| xs
-
-    maybeGetPayoutInput
-      :: Core.PayoutDatum v
-      -> (Chain.TxOutRef, Core.Payout v)
-      -> Either
-          (ConstraintError v)
-          (Maybe (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era)))
-    maybeGetPayoutInput payoutDatum (txOutRef, Core.Payout{..})
-      | case marloweVersion of
-          Core.MarloweV1 -> datum == payoutDatum = do
-          txIn <- note ToCardanoError $ toCardanoTxIn txOutRef
-          plutusScriptOrRefInput <-
-            note ToCardanoError $
-              C.PReferenceScript
-                <$> toCardanoTxIn (Language.Marlowe.Runtime.Core.ScriptRegistry.txOutRef payoutScriptUTxO)
-                <*> (Just <$> toCardanoScriptHash payoutScriptHash)
-          let plutusScriptV2InEra :: C.ScriptLanguageInEra C.PlutusScriptV2 era
-              plutusScriptV2InEra = case era of
-                C.ReferenceTxInsScriptsInlineDatumsInBabbageEra -> C.PlutusScriptV2InBabbage
-              scriptWitness =
-                C.PlutusScriptWitness
-                  plutusScriptV2InEra
-                  C.PlutusScriptV2
-                  plutusScriptOrRefInput
-                  (C.ScriptDatumForTxIn $ toCardanoScriptData $ Core.toChainPayoutDatum marloweVersion datum)
-                  (C.ScriptDataConstructor 0 [])
-                  (C.ExecutionUnits 0 0)
-          pure $ Just (txIn, C.BuildTxWith $ C.ScriptWitness C.ScriptWitnessForSpending scriptWitness)
-      | otherwise = pure Nothing
+      (MarloweInput{}, Right _) -> Left MarloweInputInWithdraw
+
+    getPayoutInputs
+      :: Either ConstraintError [((C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era)), Chain.ScriptHash)]
+    getPayoutInputs
+      | Set.null payoutInputConstraints = pure []
+      | otherwise = case scriptCtx of
+          Right PayoutContext{..} -> for (Set.toList payoutInputConstraints) \payoutRef -> do
+            Chain.TransactionOutput{..} <- note (PayoutNotFound payoutRef) $ Map.lookup payoutRef payoutOutputs
+            scriptHash <- note (InvalidPayoutScriptAddress payoutRef address) do
+              credential <- Chain.paymentCredential address
+              case credential of
+                Chain.ScriptCredential hash -> pure hash
+                _ -> Nothing
+            cardanoScriptHash <- note ToCardanoError $ toCardanoScriptHash scriptHash
+            payoutDatum <- note (InvalidPayoutDatum payoutRef datum) $ fromChainPayoutDatum marloweVersion =<< datum
+            txIn <- note ToCardanoError $ toCardanoTxIn payoutRef
+            referenceScriptOutput <-
+              note (UnknownPayoutScript scriptHash) $ Map.lookup scriptHash payoutScriptOutputs
+            referenceScriptTxIn <- note ToCardanoError $ toCardanoTxIn $ ScriptRegistry.txOutRef referenceScriptOutput
+            let plutusScriptOrRefInput = C.PReferenceScript referenceScriptTxIn $ Just cardanoScriptHash
+                plutusScriptV2InEra :: C.ScriptLanguageInEra C.PlutusScriptV2 era
+                plutusScriptV2InEra = case era of
+                  C.ReferenceTxInsScriptsInlineDatumsInBabbageEra -> C.PlutusScriptV2InBabbage
+                scriptWitness =
+                  C.PlutusScriptWitness
+                    plutusScriptV2InEra
+                    C.PlutusScriptV2
+                    plutusScriptOrRefInput
+                    (C.ScriptDatumForTxIn $ toCardanoScriptData $ Core.toChainPayoutDatum marloweVersion payoutDatum)
+                    (C.ScriptDataConstructor 0 [])
+                    (C.ExecutionUnits 0 0)
+            pure ((txIn, C.BuildTxWith $ C.ScriptWitness C.ScriptWitnessForSpending scriptWitness), scriptHash)
+          Left _ -> Left PayoutInputInCreateOrApply
 
     solveTxIns = do
       walletInputs <- getWalletInputs
       marloweInputs <- maybeToList <$> getMarloweInput
       payoutInputs <- getPayoutInputs
-      pure $ walletInputs <> marloweInputs <> payoutInputs
+      pure (walletInputs <> marloweInputs <> (fst <$> payoutInputs), Set.fromList $ snd <$> payoutInputs)
 
-    solveTxInsReference :: Either (ConstraintError v) (C.TxInsReference C.BuildTx era)
-    solveTxInsReference =
+    solveTxInsReference :: Set Chain.ScriptHash -> Either ConstraintError (C.TxInsReference C.BuildTx era)
+    solveTxInsReference requiredPayoutScriptHashes =
       maybe (pure C.TxInsReferenceNone) (fmap (C.TxInsReference era) . sequence)
       -- sequenceL is from the 'Crosswalk' type class. It behaves similarly to
       -- 'sequenceA' except that it uses 'Align' semantics instead of
@@ -1067,30 +1077,40 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
       -- sequenceL [Nothing, Just 2, Just 1] = Just [2, 1]
       -- sequenceL [Nothing, Nothing, Nothing] = Nothing
       $
-        sequenceL [marloweTxInReference, payoutTxInReference]
+        sequenceL $
+          marloweTxInReference : payoutTxInReferences requiredPayoutScriptHashes
 
     -- Only include the marlowe reference script if we are consuming a marlowe
     -- input.
-    marloweTxInReference :: Maybe (Either (ConstraintError v) C.TxIn)
-    marloweTxInReference = case marloweInputConstraints of
-      MarloweInputConstraintsNone -> Nothing
-      _ -> Just $ note ToCardanoError $ toCardanoTxIn (txOutRef marloweScriptUTxO)
+    marloweTxInReference :: Maybe (Either ConstraintError C.TxIn)
+    marloweTxInReference = case (marloweInputConstraints, scriptCtx) of
+      (MarloweInputConstraintsNone, _) -> Nothing
+      (_, Left MarloweContext{..}) -> Just $ note ToCardanoError $ toCardanoTxIn (txOutRef marloweScriptUTxO)
+      (_, Right _) -> Just $ Left MarloweInputInWithdraw
 
-    -- Only include the payout reference script if we are consuming any payout
+    -- Only include the payout reference scripts if we are consuming any payout
     -- inputs.
-    payoutTxInReference :: Maybe (Either (ConstraintError v) C.TxIn)
-    payoutTxInReference
-      | Set.null payoutInputConstraints = Nothing
-      | otherwise = Just $ note ToCardanoError $ toCardanoTxIn (txOutRef payoutScriptUTxO)
-
-    getMarloweOutput :: Maybe Chain.TransactionOutput
-    getMarloweOutput = case marloweOutputConstraints of
-      MarloweOutputConstraintsNone -> Nothing
-      MarloweOutput assets datum ->
-        Just $
-          Chain.TransactionOutput marloweAddress assets Nothing $
-            Just $
-              Core.toChainDatum marloweVersion datum
+    payoutTxInReferences :: Set Chain.ScriptHash -> [Maybe (Either ConstraintError C.TxIn)]
+    payoutTxInReferences requiredScriptHashes
+      | Set.null requiredScriptHashes = []
+      | otherwise = case scriptCtx of
+          Right PayoutContext{..} ->
+            Set.toList requiredScriptHashes <&> \payoutScriptHash -> Just do
+              ScriptRegistry.ReferenceScriptUtxo{..} <-
+                note (UnknownPayoutScript payoutScriptHash) $ Map.lookup payoutScriptHash payoutScriptOutputs
+              note ToCardanoError $ toCardanoTxIn txOutRef
+          Left _ -> [Just $ Left PayoutInputInCreateOrApply]
+
+    getMarloweOutput :: Either ConstraintError (Maybe Chain.TransactionOutput)
+    getMarloweOutput = case (marloweOutputConstraints, scriptCtx) of
+      (MarloweOutputConstraintsNone, _) -> Right Nothing
+      (MarloweOutput assets datum, Left MarloweContext{..}) ->
+        Right $
+          Just $
+            Chain.TransactionOutput marloweAddress assets Nothing $
+              Just $
+                Core.toChainDatum marloweVersion datum
+      _ -> Left MarloweOutputInWithdraw
 
     getMerkleizedContinuationOutputs :: [Chain.TransactionOutput]
     getMerkleizedContinuationOutputs = case marloweInputConstraints of
@@ -1104,7 +1124,7 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
           _ -> Nothing
       _ -> []
 
-    getRoleTokenOutputs :: Either (ConstraintError v) [Chain.TransactionOutput]
+    getRoleTokenOutputs :: Either ConstraintError [Chain.TransactionOutput]
     getRoleTokenOutputs = case roleTokenConstraints of
       RoleTokenConstraintsNone -> pure []
       MintRoleTokens _ _ distribution ->
@@ -1122,11 +1142,13 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
               containsToken = Map.member token . Chain.unTokens . Chain.tokens . Chain.assets
           note (RoleTokenNotFound token) $ snd <$> find (containsToken . snd) availTuples
 
-    getPayoutOutputs :: [Chain.TransactionOutput]
-    getPayoutOutputs = uncurry getPayoutOutput <$> Map.toList payToRoles
+    getPayoutOutputs :: Either ConstraintError [Chain.TransactionOutput]
+    getPayoutOutputs = traverse (uncurry getPayoutOutput) $ Map.toList payToRoles
 
-    getPayoutOutput :: Core.PayoutDatum v -> Chain.Assets -> Chain.TransactionOutput
-    getPayoutOutput payoutDatum assets = Chain.TransactionOutput payoutAddress assets Nothing $ Just datum
+    getPayoutOutput :: Core.PayoutDatum v -> Chain.Assets -> Either ConstraintError Chain.TransactionOutput
+    getPayoutOutput payoutDatum assets = case scriptCtx of
+      Left MarloweContext{..} -> Right $ Chain.TransactionOutput payoutAddress assets Nothing $ Just datum
+      _ -> Left PayoutOutputInWithdraw
       where
         datum = Core.toChainPayoutDatum marloweVersion payoutDatum
 
@@ -1139,12 +1161,14 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
     solveTxOuts =
       note ToCardanoError . traverse (toCardanoTxOut multiAssetSupported) =<< do
         roleTokenOutputs <- getRoleTokenOutputs
+        marloweOutput <- getMarloweOutput
+        payoutOutputs <- getPayoutOutputs
         pure $
           concat
-            [ maybeToList getMarloweOutput
+            [ maybeToList marloweOutput
             , getMerkleizedContinuationOutputs
             , roleTokenOutputs
-            , getPayoutOutputs
+            , payoutOutputs
             , getAddressOutputs
             ]
 
@@ -1167,7 +1191,7 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
       | Map.null encodedMetadata = C.TxMetadataNone
       | otherwise = C.TxMetadataInEra metadataSupported $ C.TxMetadata $ toCardanoMetadata <$> encodedMetadata
 
-    solveTxExtraKeyWits :: Either (ConstraintError v) (C.TxExtraKeyWitnesses era)
+    solveTxExtraKeyWits :: Either ConstraintError (C.TxExtraKeyWitnesses era)
     solveTxExtraKeyWits
       | Set.null signatureConstraints = pure C.TxExtraKeyWitnessesNone
       | otherwise =
@@ -1175,7 +1199,7 @@ solveInitialTxBodyContent era protocol marloweVersion MarloweContext{..} WalletC
             C.TxExtraKeyWitnesses extraKeyWitnessesSupported
               <$> traverse toCardanoPaymentKeyHash (Set.toList signatureConstraints)
 
-    solveTxMintValue :: Either (ConstraintError v) (C.TxMintValue C.BuildTx era)
+    solveTxMintValue :: Either ConstraintError (C.TxMintValue C.BuildTx era)
     solveTxMintValue = case roleTokenConstraints of
       MintRoleTokens _ witness distribution -> do
         let assetIds = Map.keysSet distribution
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
index 9a05d18a75..446ea5c345 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
@@ -17,7 +17,7 @@ import Data.Foldable (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, mapMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Type.Equality (testEquality, type (:~:) (Refl))
@@ -33,7 +33,6 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   Move (..),
   RuntimeChainSeekClient,
   ScriptHash,
-  Transaction (..),
   TxOutRef (TxOutRef),
   UTxOs (..),
   WithGenesis (..),
@@ -70,6 +69,13 @@ data LoadWalletContextField
   = ForAddresses (Set Address)
   | WalletContextLoaded WalletContext
 
+data LoadPayoutContextSelector f where
+  LoadPayoutContext :: LoadPayoutContextSelector LoadPayoutContextField
+
+data LoadPayoutContextField
+  = ForPayouts (Set TxOutRef)
+  | PayoutContextLoaded PayoutContext
+
 data LoadMarloweContextSelector f where
   LoadMarloweContext :: LoadMarloweContextSelector LoadMarloweContextField
   ContractNotFound :: LoadMarloweContextSelector Void
@@ -89,6 +95,12 @@ data ContractFoundField where
 
 type LoadWalletContext m = WalletAddresses -> m WalletContext
 
+type LoadPayoutContext m =
+  forall v
+   . MarloweVersion v
+  -> Set TxOutRef
+  -> m PayoutContext
+
 type LoadMarloweContext m =
   forall v
    . MarloweVersion v
@@ -114,6 +126,29 @@ loadWalletContext runQuery WalletAddresses{..} =
     addField ev $ WalletContextLoaded walletContext
     pure walletContext
 
+loadPayoutContext
+  :: (MonadInjectEvent r LoadPayoutContextSelector s m)
+  => (forall v. MarloweVersion v -> Set MarloweScripts)
+  -> C.NetworkId
+  -> (GetUTxOsQuery -> m UTxOs)
+  -> LoadPayoutContext m
+loadPayoutContext getScripts networkId runQuery version payouts =
+  withEvent LoadPayoutContext \ev -> do
+    addField ev $ ForPayouts payouts
+    UTxOs payoutOutputs <- runQuery $ GetUTxOsForTxOutRefs payouts
+    let payoutContext =
+          PayoutContext
+            { payoutOutputs
+            , payoutScriptOutputs =
+                Map.fromList
+                  . mapMaybe \case
+                    MarloweScripts{..} -> (payoutScript,) <$> Map.lookup networkId payoutScriptUTxOs
+                  . Set.toList
+                  $ getScripts version
+            }
+    addField ev $ PayoutContextLoaded payoutContext
+    pure payoutContext
+
 -- | Loads the current MarloweContext for a contract by its ID.
 loadMarloweContext
   :: forall m r s
@@ -193,8 +228,6 @@ loadMarloweContext getScripts networkId chainSyncConnector chainSyncQueryConnect
                                             C.NoStakeAddress
                                   , -- Get the script output of the create event.
                                     scriptOutput = Just createOutput
-                                  , -- No payouts to start with
-                                    payoutOutputs = mempty
                                   , marloweScriptUTxO
                                   , payoutScriptUTxO
                                   }
@@ -209,62 +242,58 @@ loadMarloweContext getScripts networkId chainSyncConnector chainSyncQueryConnect
        . MarloweVersion v
       -> NonEmpty (BlockHeader, MarloweContext v)
       -> ClientStIdle Move ChainPoint ChainPoint m (Either LoadMarloweContextError (MarloweContext v))
-    clientFollowContract version contexts =
-      SendMsgQueryNext
-        (FindConsumingTxs utxos)
-        ClientStNext
-          { recvMsgQueryRejected = \_ _ -> do
-              emitImmediateEvent_ ContractNotFound
-              pure $ SendMsgDone $ Left LoadMarloweContextErrorNotFound
-          , recvMsgRollBackward = \point _ -> case rollbackContexts point contexts of
-              Nothing -> do
+    clientFollowContract version contexts = case scriptUtxo of
+      Nothing -> SendMsgDone $ Right context
+      Just lastOutput ->
+        SendMsgQueryNext
+          (FindConsumingTxs $ Set.singleton lastOutput)
+          ClientStNext
+            { recvMsgQueryRejected = \_ _ -> do
                 emitImmediateEvent_ ContractNotFound
                 pure $ SendMsgDone $ Left LoadMarloweContextErrorNotFound
-              Just contexts' -> pure $ clientFollowContract version contexts'
-          , recvMsgRollForward = \txs point _ -> case point of
-              Genesis -> error "Roll forward to Genesis"
-              At blockHeader -> case scriptUtxo >>= \u -> (u,) <$> Map.lookup u txs of
-                Nothing -> pure $ clientFollowContract version $ updateContext blockHeader Nothing txs contexts
-                Just (u, scriptConsumer) -> runConnector chainSyncQueryConnector do
-                  systemStart <- request GetSystemStart
-                  eraHistory <- request GetEraHistory
-                  lift case extractMarloweTransaction
-                    version
-                    systemStart
-                    eraHistory
-                    contractId
-                    marloweAddress
-                    payoutScriptHash
-                    u
-                    blockHeader
-                    scriptConsumer of
-                    Left e -> do
-                      emitImmediateEventFields_ ExtractMarloweTransactionFailed [e]
-                      pure $ SendMsgDone $ Left $ ExtractMarloweTransactionError e
-                    Right marloweTransaction -> pure $ clientFollowContract version $ updateContext blockHeader (Just marloweTransaction) txs contexts
-          , recvMsgWait = do
-              emitImmediateEventFields_ (ContractTipFound version) [context]
-              pure $ SendMsgCancel $ SendMsgDone $ Right context
-          }
+            , recvMsgRollBackward = \point _ -> case rollbackContexts point contexts of
+                Nothing -> do
+                  emitImmediateEvent_ ContractNotFound
+                  pure $ SendMsgDone $ Left LoadMarloweContextErrorNotFound
+                Just contexts' -> pure $ clientFollowContract version contexts'
+            , recvMsgRollForward = \txs point _ -> case point of
+                Genesis -> error "Roll forward to Genesis"
+                At blockHeader -> case scriptUtxo >>= \u -> (u,) <$> Map.lookup u txs of
+                  Nothing -> pure $ clientFollowContract version $ updateContext blockHeader Nothing contexts
+                  Just (u, scriptConsumer) -> runConnector chainSyncQueryConnector do
+                    systemStart <- request GetSystemStart
+                    eraHistory <- request GetEraHistory
+                    lift case extractMarloweTransaction
+                      version
+                      systemStart
+                      eraHistory
+                      contractId
+                      marloweAddress
+                      payoutScriptHash
+                      u
+                      blockHeader
+                      scriptConsumer of
+                      Left e -> do
+                        emitImmediateEventFields_ ExtractMarloweTransactionFailed [e]
+                        pure $ SendMsgDone $ Left $ ExtractMarloweTransactionError e
+                      Right marloweTransaction -> pure $ clientFollowContract version $ updateContext blockHeader (Just marloweTransaction) contexts
+            , recvMsgWait = do
+                emitImmediateEventFields_ (ContractTipFound version) [context]
+                pure $ SendMsgCancel $ SendMsgDone $ Right context
+            }
       where
         context@MarloweContext{..} = snd $ NE.head contexts
         scriptUtxo = utxo <$> scriptOutput
-        utxos = maybe id Set.insert scriptUtxo $ Map.keysSet payoutOutputs
 
     updateContext
       :: BlockHeader
       -> Maybe (Core.Transaction v)
-      -> Map.Map TxOutRef Transaction
       -> NonEmpty (BlockHeader, MarloweContext v)
       -> NonEmpty (BlockHeader, MarloweContext v)
-    updateContext blockHeader mTransaction txs ((bh, context) :| contexts') =
+    updateContext blockHeader mTransaction ((bh, context) :| contexts') =
       ( blockHeader
       , context
           { scriptOutput = maybe (scriptOutput context) (Core.scriptOutput . Core.output) mTransaction
-          , payoutOutputs =
-              Map.withoutKeys
-                (maybe id (Map.union . Core.payouts . Core.output) mTransaction $ payoutOutputs context)
-                (Map.keysSet txs)
           }
       )
         :| ((bh, context) : contexts')
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Safety.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Safety.hs
index b827a989a2..21cbb7f8d0 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Safety.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Safety.hs
@@ -255,7 +255,7 @@ checkTransaction protocolParameters era version@MarloweV1 marloweContext@Marlowe
       . either
         (pure . TransactionValidationError transaction . show)
         (const $ TransactionWarning transaction <$> V1.txOutWarnings txOutput)
-      $ solveConstraints' era version marloweContext' walletContext constraints
+      $ solveConstraints' era version (Left marloweContext') walletContext constraints
 
 -- | Create a wallet context that will satisfy the given constraints.
 walletForConstraints
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Server.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Server.hs
index 5080c99638..a5e32ff449 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Server.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Server.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Language.Marlowe.Runtime.Transaction.Server where
 
@@ -44,7 +43,7 @@ import Control.Concurrent.Async (race)
 import Control.Concurrent.Component
 import Control.Concurrent.STM (STM, modifyTVar, newEmptyTMVar, newTVar, putTMVar, readTMVar, readTVar, retry)
 import Control.Error (MaybeT (..))
-import Control.Error.Util (hoistMaybe, hush, note, noteT)
+import Control.Error.Util (hush, note, noteT)
 import Control.Exception (Exception (..), SomeException)
 import Control.Monad (guard, (<=<))
 import Control.Monad.Event.Class
@@ -57,6 +56,7 @@ import Data.List (find)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust)
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Time (NominalDiffTime, UTCTime, nominalDiffTimeToSeconds)
 import Data.Void (Void)
@@ -65,7 +65,6 @@ import qualified Language.Marlowe.Core.V1.Semantics as V1
 import Language.Marlowe.Runtime.Cardano.Api (
   fromCardanoAddressInEra,
   fromCardanoTxId,
-  fromCardanoTxIn,
   fromCardanoTxOutDatum,
   fromCardanoTxOutValue,
   toCardanoPaymentCredential,
@@ -76,7 +75,6 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   ChainSyncQuery (..),
   Credential (..),
   DatumHash,
-  TokenName,
   TxId (..),
   fromCardanoTxMetadata,
  )
@@ -90,7 +88,7 @@ import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata,
   MarloweVersion (..),
   MarloweVersionTag (..),
-  Payout (Payout, datum),
+  Payout (Payout),
   TransactionOutput (..),
   TransactionScriptOutput (..),
   decodeMarloweTransactionMetadataLenient,
@@ -124,6 +122,7 @@ import Language.Marlowe.Runtime.Transaction.Constraints (MarloweContext (..), So
 import qualified Language.Marlowe.Runtime.Transaction.Constraints as Constraints
 import Language.Marlowe.Runtime.Transaction.Query (
   LoadMarloweContext,
+  LoadPayoutContext,
   LoadWalletContext,
   lookupMarloweScriptUtxo,
   lookupPayoutScriptUtxo,
@@ -166,6 +165,7 @@ data TransactionServerDependencies m = TransactionServerDependencies
   { mkSubmitJob :: forall era. ScriptDataSupportedInEra era -> Tx era -> STM (SubmitJob m)
   , loadWalletContext :: LoadWalletContext m
   , loadMarloweContext :: LoadMarloweContext m
+  , loadPayoutContext :: LoadPayoutContext m
   , chainSyncQueryConnector :: Connector (QueryClient ChainSyncQuery) m
   , contractQueryConnector :: Connector (QueryClient ContractRequest) m
   , getTip :: STM Chain.ChainPoint
@@ -246,17 +246,16 @@ transactionServer = component "tx-job-server" \TransactionServerDependencies{..}
                         invalidBefore
                         invalidHereafter
                         inputs
-                Withdraw version addresses contractId roleToken ->
+                Withdraw version addresses payouts ->
                   withEvent ExecWithdraw \_ ->
                     execWithdraw
                       era
                       solveConstraints
                       loadWalletContext
-                      loadMarloweContext
+                      loadPayoutContext
                       version
                       addresses
-                      contractId
-                      roleToken
+                      payouts
                 Submit ReferenceTxInsScriptsInlineDatumsInBabbageEra tx ->
                   execSubmit (mkSubmitJob ScriptDataInBabbageEra) trackSubmitJob tx
           , recvMsgAttach = \case
@@ -290,7 +289,7 @@ execCreate
   -> Chain.Lovelace
   -> Either (Contract v) DatumHash
   -> NominalDiffTime
-  -> m (ServerStCmd MarloweTxCommand Void (CreateError v) (ContractCreated v) m ())
+  -> m (ServerStCmd MarloweTxCommand Void CreateError (ContractCreated v) m ())
 execCreate era contractQueryConnector getCurrentScripts solveConstraints protocolParameters loadWalletContext networkId mStakeCredential version addresses roleTokens metadata minAda contract analysisTimeout = execExceptT do
   referenceInputsSupported <- referenceInputsSupportedInEra (CreateEraUnsupported $ AnyCardanoEra era) era
   walletContext <- lift $ loadWalletContext addresses
@@ -327,7 +326,6 @@ execCreate era contractQueryConnector getCurrentScripts solveConstraints protoco
     pure
       MarloweContext
         { scriptOutput = Nothing
-        , payoutOutputs = mempty
         , marloweAddress
         , payoutAddress
         , marloweScriptUTxO
@@ -360,7 +358,7 @@ execCreate era contractQueryConnector getCurrentScripts solveConstraints protoco
   txBody <-
     except $
       first CreateConstraintError $
-        solveConstraints referenceInputsSupported version marloweContext walletContext constraints
+        solveConstraints referenceInputsSupported version (Left marloweContext) walletContext constraints
   let marloweScriptAddress = Constraints.marloweAddress marloweContext
   pure $
     ContractCreated referenceInputsSupported $
@@ -437,7 +435,7 @@ execApplyInputs
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Inputs v
-  -> m (ServerStCmd MarloweTxCommand Void (ApplyInputsError v) (InputsApplied v) m ())
+  -> m (ServerStCmd MarloweTxCommand Void ApplyInputsError (InputsApplied v) m ())
 execApplyInputs
   era
   contractQueryConnector
@@ -487,7 +485,7 @@ execApplyInputs
     txBody <-
       except $
         first ApplyInputsConstraintError $
-          solveConstraints referenceInputsSupported version marloweContext walletContext constraints
+          solveConstraints referenceInputsSupported version (Left marloweContext) walletContext constraints
     let input = scriptOutput'
     let buildOutput (assets, datum) utxo = TransactionScriptOutput marloweAddress assets utxo datum
     let output =
@@ -512,36 +510,22 @@ execWithdraw
   => CardanoEra era
   -> SolveConstraints
   -> LoadWalletContext m
-  -> LoadMarloweContext m
+  -> LoadPayoutContext m
   -> MarloweVersion v
   -> WalletAddresses
-  -> ContractId
-  -> TokenName
-  -> m (ServerStCmd MarloweTxCommand Void (WithdrawError v) (WithdrawTx v) m ())
-execWithdraw era solveConstraints loadWalletContext loadMarloweContext version addresses contractId roleToken = execExceptT $ case version of
+  -> Set Chain.TxOutRef
+  -> m (ServerStCmd MarloweTxCommand Void WithdrawError (WithdrawTx v) m ())
+execWithdraw era solveConstraints loadWalletContext loadPayoutContext version addresses payouts = execExceptT $ case version of
   MarloweV1 -> do
     referenceInputsSupported <- referenceInputsSupportedInEra (WithdrawEraUnsupported $ AnyCardanoEra era) era
-    marloweContext@MarloweContext{payoutOutputs = Map.elems -> payouts} <-
-      withExceptT WithdrawLoadMarloweContextFailed $
-        ExceptT $
-          loadMarloweContext version contractId
-    let payoutAssetId Payout{datum = assetId} = assetId
-        isRolePayout (Chain.AssetId _ roleName) = roleName == roleToken
-        possibleDatum = find isRolePayout . map payoutAssetId $ payouts
-    datum <- noteT (UnableToFindPayoutForAGivenRole roleToken) $ hoistMaybe possibleDatum
-    constraints <- except $ buildWithdrawConstraints version datum
+    payoutContext <- lift $ loadPayoutContext version payouts
+    (inputs, constraints) <- buildWithdrawConstraints payoutContext version payouts
     walletContext <- lift $ loadWalletContext addresses
     txBody <-
       except $
         first WithdrawConstraintError $
-          solveConstraints referenceInputsSupported version marloweContext walletContext constraints
-    let inputs = getPayoutInputs marloweContext txBody
-    pure $ WithdrawTx referenceInputsSupported $ WithdrawTxInEra{roleToken = datum, ..}
-  where
-    getPayoutInputs :: MarloweContext v -> TxBody era -> Map Chain.TxOutRef (Payout v)
-    getPayoutInputs MarloweContext{..} (TxBody TxBodyContent{..}) = Map.restrictKeys payoutOutputs txIns'
-      where
-        txIns' = Set.fromList $ fromCardanoTxIn . fst <$> txIns
+          solveConstraints referenceInputsSupported version (Right payoutContext) walletContext constraints
+    pure $ WithdrawTx referenceInputsSupported $ WithdrawTxInEra{..}
 
 execSubmit
   :: (MonadUnliftIO m)

From e1690a26367d581b95fce2a1c296e61589279739 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 14:07:41 -0600
Subject: [PATCH 02/10] Update marlowe runtime clients with new withdraw API

---
 .../src/Language/Marlowe/Runtime/App.hs       |  6 +--
 .../src/Language/Marlowe/Runtime/App/Build.hs | 24 ++++------
 .../Language/Marlowe/Runtime/App/Transact.hs  | 33 ++++++++++---
 .../src/Language/Marlowe/Runtime/App/Types.hs | 22 +++++----
 .../src/Control/Monad/Trans/Marlowe/Class.hs  | 28 ++++++-----
 .../Marlowe/Runtime/CLI/Command/Apply.hs      |  2 +-
 .../Marlowe/Runtime/CLI/Command/Create.hs     | 15 +++---
 .../Marlowe/Runtime/CLI/Command/Withdraw.hs   | 48 ++++++++-----------
 8 files changed, 95 insertions(+), 83 deletions(-)

diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App.hs
index cdf7dc2ed3..202417db59 100644
--- a/marlowe-apps/src/Language/Marlowe/Runtime/App.hs
+++ b/marlowe-apps/src/Language/Marlowe/Runtime/App.hs
@@ -39,7 +39,7 @@ handle config request =
             ListHeaders{..} -> Right . Headers <$> allHeaders reqFilter
             Get{..} -> fmap (uncurry Info) <$> getContract reqContractId
             Create{..} ->
-              second (uncurry mkBody)
+              second (uncurry $ mkBody . Just)
                 <$> buildCreation
                   MarloweV1
                   reqContract
@@ -50,7 +50,7 @@ handle config request =
                   reqChange
                   reqCollateral
             Apply{..} ->
-              second (uncurry mkBody)
+              second (uncurry $ mkBody . Just)
                 <$> buildApplication
                   MarloweV1
                   reqContractId
@@ -61,7 +61,7 @@ handle config request =
                   reqAddresses
                   reqChange
                   reqCollateral
-            Withdraw{..} -> second (uncurry mkBody) <$> buildWithdrawal MarloweV1 reqContractId reqRole reqAddresses reqChange reqCollateral
+            Withdraw{..} -> second (mkBody Nothing) <$> buildWithdrawal MarloweV1 reqPayouts reqAddresses reqChange reqCollateral
             Sign{reqTxEra = ReferenceTxInsScriptsInlineDatumsInBabbageEra, ..} ->
               pure . Right . uncurry (Tx ReferenceTxInsScriptsInlineDatumsInBabbageEra) $
                 sign reqTxBody reqPaymentKeys reqPaymentExtendedKeys
diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs
index e96c2dafed..457e8984ac 100644
--- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs
+++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Build.hs
@@ -22,16 +22,13 @@ import Language.Marlowe.Runtime.App.Types (Client, TxBodyInEraWithReferenceScrip
 import Language.Marlowe.Runtime.ChainSync.Api (Address, Lovelace (..), TokenName, TxOutRef)
 import Language.Marlowe.Runtime.Core.Api (ContractId, IsMarloweVersion (..), MarloweTransactionMetadata, MarloweVersion)
 import Language.Marlowe.Runtime.Transaction.Api (
-  ApplyInputsError,
   ContractCreated (..),
   ContractCreatedInEra (..),
-  CreateError,
   InputsApplied (..),
   InputsAppliedInEra (..),
   MarloweTxCommand (ApplyInputs, Create, Withdraw),
   RoleTokensConfig (..),
   WalletAddresses (WalletAddresses),
-  WithdrawError,
   WithdrawTx (..),
   WithdrawTxInEra (..),
   mkMint,
@@ -40,12 +37,12 @@ import Network.Protocol.Job.Client (liftCommand)
 
 import qualified Data.List.NonEmpty as NE (fromList)
 import qualified Data.Map.Strict as M (Map, null, toList)
+import Data.Set (Set)
 import qualified Data.Set as S (fromList)
 import Language.Marlowe.Runtime.Client (runMarloweTxClient)
 
 buildCreation
-  :: (Show (CreateError v))
-  => MarloweVersion v
+  :: MarloweVersion v
   -> Contract v
   -> M.Map TokenName Address
   -> Lovelace
@@ -63,8 +60,7 @@ buildCreation version' contract roles minUtxo metadata' =
         \w -> Create Nothing version' w roles' metadata' minUtxo $ Left contract
 
 buildApplication
-  :: (Show (ApplyInputsError v))
-  => MarloweVersion v
+  :: MarloweVersion v
   -> ContractId
   -> Inputs v
   -> Maybe POSIXTime
@@ -82,17 +78,15 @@ buildApplication version' contractId' inputs lower upper metadata' =
     $ \w -> ApplyInputs version' w contractId' metadata' (utcTime <$> lower) (utcTime <$> upper) inputs
 
 buildWithdrawal
-  :: (Show (WithdrawError v))
-  => MarloweVersion v
-  -> ContractId
-  -> TokenName
+  :: MarloweVersion v
+  -> Set TxOutRef
   -> [Address]
   -> Address
   -> [TxOutRef]
-  -> Client (Either String (ContractId, TxBodyInEraWithReferenceScripts))
-buildWithdrawal version contractId' role =
-  build show (\(WithdrawTx era WithdrawTxInEra{txBody}) -> (contractId', TxBodyInEraWithReferenceScripts era txBody)) $
-    \w -> Withdraw version w contractId' role
+  -> Client (Either String TxBodyInEraWithReferenceScripts)
+buildWithdrawal version payouts =
+  build show (\(WithdrawTx era WithdrawTxInEra{txBody}) -> TxBodyInEraWithReferenceScripts era txBody) $
+    \w -> Withdraw version w payouts
 
 build
   :: (err -> String)
diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Transact.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Transact.hs
index 0e81f37948..ead7378954 100644
--- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Transact.hs
+++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Transact.hs
@@ -18,6 +18,8 @@ module Language.Marlowe.Runtime.App.Transact (
   runWithEvents,
   transact,
   transactWithEvents,
+  transact',
+  transactWithEvents',
 ) where
 
 import Control.Concurrent (threadDelay)
@@ -66,9 +68,9 @@ runWithEvents
   -> App ContractId
 runWithEvents backend config address key contract inputs minUtxo =
   do
-    let transact' = transactWithEvents backend config key
-    contractId <- transact' $ Create contract mempty minUtxo mempty mempty address mempty
-    mapM_ (\input -> transact' $ Apply contractId input Nothing Nothing mempty mempty address mempty) inputs
+    let transact'' = transactWithEvents' backend config key
+    contractId <- transact'' $ Create contract mempty minUtxo mempty mempty address mempty
+    mapM_ (\input -> transact'' $ Apply contractId input Nothing Nothing mempty mempty address mempty) inputs
     pure contractId
 
 create
@@ -89,7 +91,7 @@ createWithEvents
   -> Lovelace
   -> App ContractId
 createWithEvents backend config address key contract minUtxo =
-  transactWithEvents backend config key $
+  transactWithEvents' backend config key $
     Create contract mempty minUtxo mempty mempty address mempty
 
 apply
@@ -110,22 +112,39 @@ applyWithEvents
   -> [Input]
   -> App ContractId
 applyWithEvents backend config address key contractId input =
-  transactWithEvents backend config key $
+  transactWithEvents' backend config key $
     Apply contractId input Nothing Nothing mempty mempty address mempty
 
-transact
+transact'
   :: Config
   -> C.SigningKey C.PaymentExtendedKey
   -> MarloweRequest 'V1
   -> App ContractId
+transact' = transactWithEvents' unitEventBackend
+
+transact
+  :: Config
+  -> C.SigningKey C.PaymentExtendedKey
+  -> MarloweRequest 'V1
+  -> App (Maybe ContractId)
 transact = transactWithEvents unitEventBackend
 
-transactWithEvents
+transactWithEvents'
   :: EventBackend App r DynamicEventSelector
   -> Config
   -> C.SigningKey C.PaymentExtendedKey
   -> MarloweRequest 'V1
   -> App ContractId
+transactWithEvents' backend config key request = do
+  mContractId <- transactWithEvents backend config key request
+  maybe (fail "Contract ID expected") pure mContractId
+
+transactWithEvents
+  :: EventBackend App r DynamicEventSelector
+  -> Config
+  -> C.SigningKey C.PaymentExtendedKey
+  -> MarloweRequest 'V1
+  -> App (Maybe ContractId)
 transactWithEvents backend config@Config{buildSeconds, confirmSeconds, retryLimit, retrySeconds} key request =
   let show' = LBS8.unpack . A.encode
       unexpected response = throwError $ "Unexpected response: " <> show' response
diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs
index 891dc5b101..5b07ccdb9b 100644
--- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs
+++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs
@@ -54,6 +54,7 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   TxOutRef,
   fromBech32,
   fromJSONEncodedTransactionMetadata,
+  parseTxOutRef,
   toBech32,
  )
 import Language.Marlowe.Runtime.Core.Api (
@@ -105,6 +106,8 @@ import qualified Data.Aeson.Types as A (
  )
 import Data.Foldable (fold)
 import qualified Data.Map.Strict as M (Map, map, mapKeys)
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified Data.Text as T (Text)
 import Data.Time.Units (Second)
 import Language.Marlowe.Protocol.Client (hoistMarloweRuntimeClient)
@@ -225,8 +228,7 @@ data MarloweRequest v
       , reqCollateral :: [TxOutRef]
       }
   | Withdraw
-      { reqContractId :: ContractId
-      , reqRole :: TokenName
+      { reqPayouts :: Set TxOutRef
       , reqAddresses :: [Address]
       , reqChange :: Address
       , reqCollateral :: [TxOutRef]
@@ -283,8 +285,8 @@ instance A.FromJSON (MarloweRequest 'V1) where
               reqCollateral <- fmap fromString <$> o A..: "collateral"
               pure Apply{..}
             "withdraw" -> do
-              reqContractId <- fromString <$> o A..: "contractId"
-              reqRole <- fromString <$> o A..: "role"
+              reqPayouts <-
+                Set.fromList <$> (traverse (maybe (fail "invalid tx out ref syntax") pure . parseTxOutRef) =<< o A..: "payouts")
               reqAddresses <- mapM addressFromJSON =<< o A..: "addresses"
               reqChange <- addressFromJSON =<< o A..: "change"
               reqCollateral <- fmap fromString <$> o A..: "collateral"
@@ -358,7 +360,7 @@ instance A.ToJSON (MarloweRequest 'V1) where
   toJSON Withdraw{..} =
     A.object
       [ "request" A..= ("withdraw" :: String)
-      , "role" A..= reqRole
+      , "payouts" A..= reqPayouts
       , "addresses" A..= fmap addressToJSON reqAddresses
       , "change" A..= addressToJSON reqChange
       , "collateral" A..= reqCollateral
@@ -408,7 +410,7 @@ data MarloweResponse v
   | forall era.
     Body
       { resTxEra :: C.ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-      , resContractId :: ContractId
+      , resContractId :: Maybe ContractId
       , resTxId :: TxId
       , resTxBody :: C.TxBody era
       }
@@ -448,15 +450,17 @@ instance A.ToJSON (MarloweResponse 'V1) where
       , "steps" A..= fmap contractStepToJSON resSteps
       ]
   toJSON Body{..} =
-    A.object
+    A.object $
       [ "response" A..= ("body" :: String)
-      , "contractId" A..= renderContractId resContractId
       , "txId" A..= C.getTxId resTxBody
       , case resTxEra of
           C.ReferenceTxInsScriptsInlineDatumsInBabbageEra -> "era" A..= C.BabbageEra
       , case resTxEra of
           C.ReferenceTxInsScriptsInlineDatumsInBabbageEra -> "body" A..= textEnvelopeToJSON resTxBody
       ]
+        <> case resContractId of
+          Nothing -> []
+          Just contractId -> ["contractId" A..= contractId]
   toJSON Tx{..} =
     A.object
       [ "response" A..= ("tx" :: String)
@@ -540,7 +544,7 @@ textEnvelopeToJSON x =
   let envelope = C.serialiseToTextEnvelope Nothing x
    in A.toJSON envelope
 
-mkBody :: ContractId -> TxBodyInEraWithReferenceScripts -> MarloweResponse v
+mkBody :: Maybe ContractId -> TxBodyInEraWithReferenceScripts -> MarloweResponse v
 mkBody resContractId (TxBodyInEraWithReferenceScripts resTxEra resTxBody) =
   let resTxId = fromCardanoTxId $ C.getTxId resTxBody
    in Body{..}
diff --git a/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs b/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs
index b3cb923567..f6261c87d7 100644
--- a/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs
+++ b/marlowe-client/src/Control/Monad/Trans/Marlowe/Class.hs
@@ -14,6 +14,7 @@ import Control.Monad.Trans.Reader (ReaderT (..))
 import Control.Monad.Trans.Resource.Internal (ResourceT (..))
 import Data.Coerce (coerce)
 import Data.Foldable (asum)
+import Data.Set (Set)
 import Data.Time (UTCTime)
 import Language.Marlowe.Protocol.Client (MarloweRuntimeClient (..), hoistMarloweRuntimeClient)
 import Language.Marlowe.Protocol.HeaderSync.Client (MarloweHeaderSyncClient)
@@ -23,7 +24,14 @@ import Language.Marlowe.Protocol.Sync.Client (MarloweSyncClient)
 import Language.Marlowe.Protocol.Transfer.Client (
   MarloweTransferClient,
  )
-import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, DatumHash, Lovelace, StakeCredential, TokenName, TxId)
+import Language.Marlowe.Runtime.ChainSync.Api (
+  BlockHeader,
+  DatumHash,
+  Lovelace,
+  StakeCredential,
+  TxId,
+  TxOutRef,
+ )
 import Language.Marlowe.Runtime.Contract.Api (ContractRequest)
 import Language.Marlowe.Runtime.Core.Api (
   Contract,
@@ -209,7 +217,7 @@ createContract
   -- ^ Min Lovelace which should be used for the contract output.
   -> Either (Contract v) DatumHash
   -- ^ The contract to run, or the hash of the contract to look up in the store.
-  -> m (Either (CreateError v) (ContractCreated v))
+  -> m (Either CreateError (ContractCreated v))
 createContract mStakeCredential version wallet roleTokens metadata lovelace contract =
   runMarloweTxClient $
     liftCommand $
@@ -241,7 +249,7 @@ applyInputs'
   -- is computed from the contract.
   -> Inputs v
   -- ^ The inputs to apply.
-  -> m (Either (ApplyInputsError v) (InputsApplied v))
+  -> m (Either ApplyInputsError (InputsApplied v))
 applyInputs' version wallet contractId metadata invalidBefore invalidHereafter inputs =
   runMarloweTxClient $
     liftCommand $
@@ -267,7 +275,7 @@ applyInputs
   -- ^ Optional metadata to attach to the transaction
   -> Inputs v
   -- ^ The inputs to apply.
-  -> m (Either (ApplyInputsError v) (InputsApplied v))
+  -> m (Either ApplyInputsError (InputsApplied v))
 applyInputs version wallet contractId metadata =
   applyInputs' version wallet contractId metadata Nothing Nothing
 
@@ -278,13 +286,11 @@ withdraw
   -- ^ The Marlowe version to use
   -> WalletAddresses
   -- ^ The wallet addresses to use when constructing the transaction
-  -> ContractId
-  -- ^ The ID of the contract to apply the inputs to.
-  -> TokenName
-  -- ^ The names of the roles whose assets to withdraw.
-  -> m (Either (WithdrawError v) (WithdrawTx v))
-withdraw version wallet contractId role =
-  runMarloweTxClient $ liftCommand $ Withdraw version wallet contractId role
+  -> Set TxOutRef
+  -- ^ The IDs of the payouts to withdraw.
+  -> m (Either WithdrawError (WithdrawTx v))
+withdraw version wallet payouts =
+  runMarloweTxClient $ liftCommand $ Withdraw version wallet payouts
 
 -- | Submit a signed transaction via the Marlowe Runtime. Waits for completion
 -- with exponential back-off in the polling.
diff --git a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Apply.hs b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Apply.hs
index b63b514994..6c22de0437 100644
--- a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Apply.hs
+++ b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Apply.hs
@@ -55,7 +55,7 @@ data ApplyCommand = V1ApplyCommand
   }
 
 data ApplyCommandError v
-  = ApplyFailed (ApplyInputsError v)
+  = ApplyFailed ApplyInputsError
   | InputsWithContinuationsUnsupported (ContractInputs v)
   | InputsDecodingFailed (Maybe Yaml.ParseException)
   | TransactionFileWriteFailed (C.FileError ())
diff --git a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Create.hs b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Create.hs
index 2369afaaab..19baac4ec8 100644
--- a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Create.hs
+++ b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Create.hs
@@ -46,7 +46,6 @@ import Language.Marlowe.Runtime.Core.Api (
   MarloweMetadata (..),
   MarloweTransactionMetadata (..),
   MarloweVersion (MarloweV1),
-  MarloweVersionTag (V1),
   SomeMarloweVersion (SomeMarloweVersion),
  )
 import Language.Marlowe.Runtime.Transaction.Api (
@@ -96,8 +95,8 @@ data ContractArgsValue = ContractArgsValue
   , valueArguments :: Map String Integer
   }
 
-data CreateCommandError v
-  = CreateFailed (CreateError v)
+data CreateCommandError
+  = CreateFailed CreateError
   | ContractFileDecodingError Yaml.ParseException
   | TransactionFileWriteFailed (C.FileError ())
   | RolesConfigFileDecodingError String
@@ -105,7 +104,7 @@ data CreateCommandError v
   | TagsDecodingFailed (Maybe Yaml.ParseException)
   | ExtendedContractsAreNotSupportedYet
 
-deriving instance Show (CreateCommandError 'V1)
+deriving instance Show CreateCommandError
 
 createCommandParser :: ParserInfo (TxCommand CreateCommand)
 createCommandParser = info (txCommandParser True parser) $ progDesc "Create a new Marlowe Contract"
@@ -252,7 +251,7 @@ runCreateCommand TxCommand{walletAddresses, signingMethod, tagsFile, metadataFil
           BS8.hPutStrLn stderr $ Yaml.encode safetyErrors
     liftIO . print $ A.encode (A.object [("contractId", A.toJSON . renderTxOutRef $ contractId)])
   where
-    readContract :: MarloweVersion v -> ExceptT (CreateCommandError v) CLI (Either (Contract v) DatumHash)
+    readContract :: MarloweVersion v -> ExceptT CreateCommandError CLI (Either (Contract v) DatumHash)
     readContract = \case
       MarloweV1 -> case contractFiles of
         CoreFile filePath -> ExceptT $ liftIO $ bimap ContractFileDecodingError Left <$> decodeFileEither filePath
@@ -261,14 +260,14 @@ runCreateCommand TxCommand{walletAddresses, signingMethod, tagsFile, metadataFil
           throwE ExtendedContractsAreNotSupportedYet
         ContractHash hash -> pure $ Right hash
 
-    readMetadata :: ExceptT (CreateCommandError v) CLI TransactionMetadata
+    readMetadata :: ExceptT CreateCommandError CLI TransactionMetadata
     readMetadata = case metadataFile of
       Just filePath -> do
         metadataJSON <- ExceptT $ liftIO $ first (MetadataDecodingFailed . Just) <$> decodeFileEither filePath
         noteT (MetadataDecodingFailed Nothing) $ hoistMaybe (fromJSONEncodedTransactionMetadata metadataJSON)
       Nothing -> pure mempty
 
-    readTags :: ExceptT (CreateCommandError v) CLI (Maybe MarloweMetadata)
+    readTags :: ExceptT CreateCommandError CLI (Maybe MarloweMetadata)
     readTags = case tagsFile of
       Just filePath ->
         Just <$> do
@@ -277,7 +276,7 @@ runCreateCommand TxCommand{walletAddresses, signingMethod, tagsFile, metadataFil
           pure $ MarloweMetadata tags Nothing
       Nothing -> pure Nothing
 
-    run :: MarloweVersion v -> RoleTokensConfig -> ExceptT (CreateCommandError v) CLI (ContractId, [SafetyError])
+    run :: MarloweVersion v -> RoleTokensConfig -> ExceptT CreateCommandError CLI (ContractId, [SafetyError])
     run version rolesDistribution = do
       contract <- readContract version
       metadata <- MarloweTransactionMetadata <$> readTags <*> readMetadata
diff --git a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Withdraw.hs b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Withdraw.hs
index 7011d0f04c..5322695025 100644
--- a/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Withdraw.hs
+++ b/marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Withdraw.hs
@@ -11,58 +11,48 @@ import Control.Monad.Trans.Except (ExceptT (ExceptT))
 import Data.Aeson (toJSON)
 import qualified Data.Aeson as A
 import Data.Bifunctor (first)
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Language.Marlowe.Runtime.CLI.Command.Tx (SigningMethod (Manual), TxCommand (..), txCommandParser)
 import Language.Marlowe.Runtime.CLI.Monad (CLI, runCLIExceptT)
 import Language.Marlowe.Runtime.CLI.Option (marloweVersionParser, txOutRefParser)
-import Language.Marlowe.Runtime.ChainSync.Api (TokenName (TokenName))
+import Language.Marlowe.Runtime.ChainSync.Api (TxOutRef)
 import Language.Marlowe.Runtime.Client (withdraw)
 import Language.Marlowe.Runtime.Core.Api (
-  ContractId (ContractId),
   MarloweVersion (MarloweV1),
-  MarloweVersionTag (V1),
   SomeMarloweVersion (SomeMarloweVersion),
  )
 import Language.Marlowe.Runtime.Transaction.Api (WithdrawError, WithdrawTx (..), WithdrawTxInEra (..))
 import Options.Applicative
 
 data WithdrawCommand = WithdrawCommand
-  { contractId :: ContractId
-  , marloweVersion :: SomeMarloweVersion
-  , role :: TokenName
+  { marloweVersion :: SomeMarloweVersion
+  , payouts :: Set TxOutRef
   }
 
-data WithdrawCommandError v
-  = WithdrawFailed (WithdrawError v)
+data WithdrawCommandError
+  = WithdrawFailed WithdrawError
   | TransactionFileWriteFailed (C.FileError ())
-
-deriving instance Show (WithdrawCommandError 'V1)
+  deriving (Show)
 
 withdrawCommandParser :: ParserInfo (TxCommand WithdrawCommand)
-withdrawCommandParser = info (txCommandParser False parser) $ progDesc "Withdraw funds paid to a role in a contract"
+withdrawCommandParser = info (txCommandParser False parser) $ progDesc "Withdraw funds paid roles in contracts"
   where
-    parser = WithdrawCommand <$> contractIdParser <*> marloweVersionParser <*> roleParser
-    contractIdParser =
-      option (ContractId <$> txOutRefParser) $
-        mconcat
-          [ long "contract"
-          , short 'c'
-          , metavar "CONTRACT_ID"
-          , help "The ID of the Marlowe contract from which to withdraw funds."
-          ]
-    roleParser =
-      fmap TokenName $
-        strOption $
-          mconcat
-            [ long "role"
-            , metavar "ROLE_NAME"
-            , help "The name of the role from which to withdraw funds."
-            ]
+    parser = WithdrawCommand <$> marloweVersionParser <*> payoutsParser
+    payoutsParser =
+      fmap Set.fromList $
+        some $
+          argument txOutRefParser $
+            mconcat
+              [ metavar "TX_ID#TX_IX"
+              , help "A payout output to withdraw."
+              ]
 
 runWithdrawCommand :: TxCommand WithdrawCommand -> CLI ()
 runWithdrawCommand TxCommand{walletAddresses, signingMethod, subCommand = WithdrawCommand{..}} = case marloweVersion of
   SomeMarloweVersion MarloweV1 -> runCLIExceptT do
     WithdrawTx era WithdrawTxInEra{..} <-
-      ExceptT $ first WithdrawFailed <$> withdraw MarloweV1 walletAddresses contractId role
+      ExceptT $ first WithdrawFailed <$> withdraw MarloweV1 walletAddresses payouts
     case signingMethod of
       Manual outputFile -> do
         ExceptT @_ @_ @() $

From de7142e5337002b79487e17bd29b9c6f51cdcd33 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 14:32:16 -0600
Subject: [PATCH 03/10] Update marlowe runtime web with new withdraw API

---
 .../Marlowe/Runtime/Web/Server/DTO.hs         | 10 +++
 .../Marlowe/Runtime/Web/Server/Monad.hs       |  4 +-
 .../Runtime/Web/Server/REST/ApiError.hs       | 68 ++++++++-----------
 .../Runtime/Web/Server/REST/Withdrawals.hs    |  5 +-
 .../Marlowe/Runtime/Web/Server/TxClient.hs    | 20 +++---
 .../src/Language/Marlowe/Runtime/Web/Types.hs |  5 +-
 marlowe-runtime-web/test/Spec.hs              |  2 +-
 7 files changed, 52 insertions(+), 62 deletions(-)

diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index ac4cfdd265..489a4c4e3f 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -90,6 +90,7 @@ import Language.Marlowe.Protocol.Query.Types (
 import Data.Bitraversable (Bitraversable (..))
 import Data.Function (on)
 import Data.List (groupBy)
+import Data.Set (Set)
 import qualified Language.Marlowe.Protocol.Query.Types as Query
 import Language.Marlowe.Runtime.Cardano.Api (cardanoEraToAsType, fromCardanoTxId)
 import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..))
@@ -150,6 +151,15 @@ instance (FromDTO k, FromDTO a) => FromDTO (Map k a) where
 instance (ToDTO k, ToDTO a) => ToDTO (Map k a) where
   toDTO = Map.mapKeysMonotonic toDTO . fmap toDTO
 
+instance HasDTO (Set a) where
+  type DTO (Set a) = Set (DTO a)
+
+instance (FromDTO a) => FromDTO (Set a) where
+  fromDTO = fmap Set.fromDistinctAscList . traverse fromDTO . Set.toAscList
+
+instance (ToDTO a) => ToDTO (Set a) where
+  toDTO = Set.mapMonotonic toDTO
+
 instance HasDTO [a] where
   type DTO [a] = [DTO a]
 
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Monad.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Monad.hs
index 6bf7281e3d..ecdc17f873 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Monad.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Monad.hs
@@ -149,9 +149,9 @@ applyInputs version addresses contractId metadata invalidBefore invalidHereafter
 
 -- | Withdraw funds from a role.
 withdraw :: Withdraw ServerM
-withdraw version addresses contractId role = do
+withdraw version addresses payouts = do
   AppEnv{_eventBackend = backend, _withdraw = _withdraw} <- ask
-  liftBackendM backend $ _withdraw version addresses contractId role
+  liftBackendM backend $ _withdraw version addresses payouts
 
 -- | Submit a contract creation transaction to the node
 submitContract :: ContractId -> Submit' ServerM
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
index ffc525cdd5..88a848bcca 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
@@ -12,7 +12,6 @@ module Language.Marlowe.Runtime.Web.Server.REST.ApiError where
 import Control.Monad.Except (MonadError (throwError))
 import Data.Aeson (ToJSON (toJSON), Value (Null), encode, object, (.=))
 import Data.Maybe (fromMaybe)
-import Language.Marlowe.Runtime.Core.Api (MarloweVersionTag (..))
 import Language.Marlowe.Runtime.Transaction.Api (
   ApplyInputsConstraintsBuildupError (..),
   ApplyInputsError (..),
@@ -111,43 +110,32 @@ rangeNotSatisfiable msg errorCode = toServerError . ApiError msg (fromMaybe "Ran
 rangeNotSatisfiable' :: String -> ServerError
 rangeNotSatisfiable' msg = rangeNotSatisfiable msg Nothing
 
-instance HasDTO (WithdrawError 'V1) where
-  type DTO (WithdrawError 'V1) = ApiError
+instance HasDTO WithdrawError where
+  type DTO WithdrawError = ApiError
 
-instance ToDTO (WithdrawError 'V1) where
+instance ToDTO WithdrawError where
   toDTO = \case
     WithdrawEraUnsupported era -> ApiError ("Current network era not supported: " <> show era) "WithdrawEraUnsupported" Null 503
-    WithdrawConstraintError (MintingUtxoNotFound _) -> ApiError "Minting UTxO not found" "MintingUtxoNotFound" Null 500
-    WithdrawConstraintError (RoleTokenNotFound _) -> ApiError "Role token not found" "RoleTokenNotFound" Null 403
-    WithdrawConstraintError ToCardanoError -> ApiError "Internal error" "ToCardanoError" Null 500
-    WithdrawConstraintError MissingMarloweInput -> ApiError "Internal error" "MissingMarloweInput" Null 500
-    WithdrawConstraintError (PayoutInputNotFound _) -> ApiError "Internal error" "PayoutInputNotFound" Null 500
-    WithdrawConstraintError (CalculateMinUtxoFailed _) -> ApiError "Internal error" "CalculateMinUtxoFailed" Null 500
-    WithdrawConstraintError (CoinSelectionFailed msg) -> ApiError ("Coin selection failed: " <> msg) "CoinSelectionFailed" Null 400
-    WithdrawConstraintError (BalancingError _) -> ApiError "Internal error" "BalancingError" Null 500
-    WithdrawLoadMarloweContextFailed LoadMarloweContextErrorNotFound -> ApiError "Marlowe contract not found" "MarloweContractNotFound" Null 404
-    WithdrawLoadMarloweContextFailed (LoadMarloweContextErrorVersionMismatch _) -> ApiError "Marlowe contract version mismatch" "MarloweContractVersionMismatch" Null 400
-    WithdrawLoadMarloweContextFailed LoadMarloweContextToCardanoError -> ApiError "Internal error" "LoadMarloweContextToCardanoError" Null 500
-    WithdrawLoadMarloweContextFailed (MarloweScriptNotPublished _) -> ApiError "Internal error" "MarloweScriptNotPublished" Null 500
-    WithdrawLoadMarloweContextFailed (PayoutScriptNotPublished _) -> ApiError "Internal error" "PayoutScriptNotPublished" Null 500
-    WithdrawLoadMarloweContextFailed (ExtractCreationError _) -> ApiError "Internal error" "ExtractCreationError" Null 500
-    WithdrawLoadMarloweContextFailed (ExtractMarloweTransactionError _) -> ApiError "Internal error" "ExtractMarloweTransactionError" Null 500
+    WithdrawConstraintError err -> ApiError (show err) "ConstraintError" Null case err of
+      MintingUtxoNotFound _ -> 400
+      RoleTokenNotFound _ -> 400
+      PayoutNotFound _ -> 400
+      CoinSelectionFailed _ -> 400
+      _ -> 500
     UnableToFindPayoutForAGivenRole _ -> ApiError "No payouts available for given role" "UnableToFindPayoutForAGivenRole" Null 409
 
-instance HasDTO (CreateError 'V1) where
-  type DTO (CreateError 'V1) = ApiError
+instance HasDTO CreateError where
+  type DTO CreateError = ApiError
 
-instance ToDTO (CreateError 'V1) where
+instance ToDTO CreateError where
   toDTO = \case
     CreateEraUnsupported era -> ApiError ("Current network era not supported: " <> show era) "WithdrawEraUnsupported" Null 503
-    CreateConstraintError (MintingUtxoNotFound _) -> ApiError "Minting UTxO not found" "MintingUtxoNotFound" Null 500
-    CreateConstraintError (RoleTokenNotFound _) -> ApiError "Role token not found" "RoleTokenNotFound" Null 403
-    CreateConstraintError ToCardanoError -> ApiError "Internal error" "ToCardanoError" Null 500
-    CreateConstraintError MissingMarloweInput -> ApiError "Internal error" "MissingMarloweInput" Null 500
-    CreateConstraintError (PayoutInputNotFound _) -> ApiError "Internal error" "PayoutInputNotFound" Null 500
-    CreateConstraintError (CalculateMinUtxoFailed _) -> ApiError "Internal error" "CalculateMinUtxoFailed" Null 500
-    CreateConstraintError (CoinSelectionFailed msg) -> ApiError ("Coin selection failed: " <> msg) "CoinSelectionFailed" Null 400
-    CreateConstraintError (BalancingError _) -> ApiError "Internal error" "BalancingError" Null 500
+    CreateConstraintError err -> ApiError (show err) "ConstraintError" Null case err of
+      MintingUtxoNotFound _ -> 400
+      RoleTokenNotFound _ -> 400
+      PayoutNotFound _ -> 400
+      CoinSelectionFailed _ -> 400
+      _ -> 500
     CreateLoadMarloweContextFailed LoadMarloweContextErrorNotFound -> ApiError "Marlowe contract not found" "MarloweContractNotFound" Null 404
     CreateLoadMarloweContextFailed (LoadMarloweContextErrorVersionMismatch _) -> ApiError "Marlowe contract version mismatch" "MarloweContractVersionMismatch" Null 400
     CreateLoadMarloweContextFailed LoadMarloweContextToCardanoError -> ApiError "Internal error" "LoadMarloweContextToCardanoError" Null 500
@@ -162,20 +150,18 @@ instance ToDTO (CreateError 'V1) where
     CreateSafetyAnalysisError _ -> ApiError "Safety analysis failed" "InternalError" Null 400
     CreateContractNotFound -> ApiError "Contract not found" "Not found" Null 404
 
-instance HasDTO (ApplyInputsError 'V1) where
-  type DTO (ApplyInputsError 'V1) = ApiError
+instance HasDTO ApplyInputsError where
+  type DTO ApplyInputsError = ApiError
 
-instance ToDTO (ApplyInputsError 'V1) where
+instance ToDTO ApplyInputsError where
   toDTO = \case
     ApplyInputsEraUnsupported era -> ApiError ("Current network era not supported: " <> show era) "WithdrawEraUnsupported" Null 503
-    ApplyInputsConstraintError (MintingUtxoNotFound _) -> ApiError "Minting UTxO not found" "MintingUtxoNotFound" Null 500
-    ApplyInputsConstraintError (RoleTokenNotFound _) -> ApiError "Role token not found" "RoleTokenNotFound" Null 403
-    ApplyInputsConstraintError ToCardanoError -> ApiError "Internal error" "ToCardnoError" Null 500
-    ApplyInputsConstraintError MissingMarloweInput -> ApiError "Internal error" "MissingMarloweInput" Null 500
-    ApplyInputsConstraintError (PayoutInputNotFound _) -> ApiError "Internal error" "PayoutInputNotFound" Null 500
-    ApplyInputsConstraintError (CalculateMinUtxoFailed _) -> ApiError "Internal error" "CalculateMinUtxoFailed" Null 500
-    ApplyInputsConstraintError (CoinSelectionFailed msg) -> ApiError ("Coin selection failed: " <> msg) "CoinSelectionFailed" Null 400
-    ApplyInputsConstraintError (BalancingError _) -> ApiError "Internal error" "BalancingError" Null 500
+    ApplyInputsConstraintError err -> ApiError (show err) "ConstraintError" Null case err of
+      MintingUtxoNotFound _ -> 400
+      RoleTokenNotFound _ -> 400
+      PayoutNotFound _ -> 400
+      CoinSelectionFailed _ -> 400
+      _ -> 500
     ScriptOutputNotFound -> ApiError "Script output not found" "ScriptOutputNotFound" Null 400
     ApplyInputsLoadMarloweContextFailed LoadMarloweContextErrorNotFound -> ApiError "Marlowe contract not found" "MarloweContractNotFound" Null 404
     ApplyInputsLoadMarloweContextFailed (LoadMarloweContextErrorVersionMismatch _) -> ApiError "Marlowe contract version mismatch" "MarloweContractVersionMismatch" Null 400
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
index 053aedf094..842f535e67 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
@@ -56,9 +56,8 @@ postCreateTxBody PostWithdrawalsRequest{..} changeAddressDTO mAddresses mCollate
   collateralUtxos <-
     Set.fromList
       <$> fromDTOThrow (badRequest' "Invalid collateral header UTxO value") (maybe [] unCommaList mCollateralUtxos)
-  role' <- fromDTOThrow (badRequest' "Invalid role") role
-  contractId' <- fromDTOThrow (badRequest' "Invalid contract id") contractId
-  withdraw MarloweV1 WalletAddresses{..} contractId' role' >>= \case
+  payouts' <- fromDTOThrow (badRequest' "Invalid payouts") payouts
+  withdraw MarloweV1 WalletAddresses{..} payouts' >>= \case
     Left err -> throwDTOError err
     Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
 
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/TxClient.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/TxClient.hs
index ce3d297d5c..f2a14e94ee 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/TxClient.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/TxClient.hs
@@ -33,10 +33,11 @@ import Control.Monad.Event.Class
 import Control.Monad.IO.Unlift (MonadUnliftIO, liftIO, withRunInIO)
 import Data.Foldable (for_)
 import qualified Data.Map as Map
+import Data.Set (Set)
 import Data.Time (UTCTime)
 import Language.Marlowe.Protocol.Client (MarloweRuntimeClient (..))
 import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
-import Language.Marlowe.Runtime.ChainSync.Api (DatumHash, Lovelace, StakeCredential, TokenName, TxId)
+import Language.Marlowe.Runtime.ChainSync.Api (DatumHash, Lovelace, StakeCredential, TxId, TxOutRef)
 import Language.Marlowe.Runtime.Core.Api (
   Contract,
   ContractId,
@@ -78,7 +79,7 @@ type CreateContract m =
   -> MarloweTransactionMetadata
   -> Lovelace
   -> Either (Contract v) DatumHash
-  -> m (Either (CreateError v) (ContractCreated v))
+  -> m (Either CreateError (ContractCreated v))
 
 type ApplyInputs m =
   forall v
@@ -89,15 +90,14 @@ type ApplyInputs m =
   -> Maybe UTCTime
   -> Maybe UTCTime
   -> Inputs v
-  -> m (Either (ApplyInputsError v) (InputsApplied v))
+  -> m (Either ApplyInputsError (InputsApplied v))
 
 type Withdraw m =
   forall v
    . MarloweVersion v
   -> WalletAddresses
-  -> ContractId
-  -> TokenName
-  -> m (Either (WithdrawError v) (WithdrawTx v))
+  -> Set TxOutRef
+  -> m (Either WithdrawError (WithdrawTx v))
 
 data TempTxStatus = Unsigned | Submitted
 
@@ -238,12 +238,8 @@ txClient = component "web-tx-client" \TxClientDependencies{..} -> do
                 modifyTVar tempTransactions $
                   Map.alter (Just . maybe (Map.singleton txId tempTx) (Map.insert txId tempTx)) contractId
             pure response
-        , withdraw = \version addresses contractId role -> do
-            response <-
-              runConnector connector $
-                RunTxClient $
-                  liftCommand $
-                    Withdraw version addresses contractId role
+        , withdraw = \version addresses payouts -> do
+            response <- runConnector connector $ RunTxClient $ liftCommand $ Withdraw version addresses payouts
             liftIO $ for_ response \(WithdrawTx era withdrawal@WithdrawTxInEra{txBody}) ->
               atomically $
                 modifyTVar tempWithdrawals $
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
index c0b232f28e..082eced57a 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
@@ -718,9 +718,8 @@ instance FromJSON PostContractSourceResponse
 instance ToJSON PostContractSourceResponse
 instance ToSchema PostContractSourceResponse
 
-data PostWithdrawalsRequest = PostWithdrawalsRequest
-  { role :: Text
-  , contractId :: TxOutRef
+newtype PostWithdrawalsRequest = PostWithdrawalsRequest
+  { payouts :: Set TxOutRef
   }
   deriving (Show, Eq, Ord, Generic)
 
diff --git a/marlowe-runtime-web/test/Spec.hs b/marlowe-runtime-web/test/Spec.hs
index d4ae782924..9a6b3f8fdd 100644
--- a/marlowe-runtime-web/test/Spec.hs
+++ b/marlowe-runtime-web/test/Spec.hs
@@ -194,7 +194,7 @@ instance Arbitrary Web.Tx where
   shrink = genericShrink
 
 instance Arbitrary Web.PostWithdrawalsRequest where
-  arbitrary = Web.PostWithdrawalsRequest <$> arbitrary <*> arbitrary
+  arbitrary = Web.PostWithdrawalsRequest <$> arbitrary
 
 instance Arbitrary Web.PostContractsRequest where
   arbitrary =

From d21b5aae2391e4e66b16d4191d08d1e78e522c59 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 15:48:05 -0600
Subject: [PATCH 04/10] Update integration tests and marlowe-cli testing DSL

---
 .../Marlowe/CLI/Test/Runtime/Interpret.hs     | 15 ++++-
 marlowe-cli/marlowe-cli.cabal                 |  2 +-
 .../test/Language/Marlowe/Runtime/CliSpec.hs  | 63 ++++++++++---------
 .../Marlowe/Runtime/Integration/Common.hs     | 10 +--
 .../Marlowe/Runtime/Integration/Create.hs     |  4 +-
 .../Runtime/Integration/StandardContract.hs   |  6 +-
 .../Marlowe/Runtime/Integration/Withdraw.hs   | 23 ++++---
 .../Language/Marlowe/Runtime/Web/Common.hs    |  9 ++-
 .../Marlowe/Runtime/Web/StandardContract.hs   |  7 ++-
 .../Marlowe/Runtime/Web/Withdrawal/Post.hs    | 14 ++---
 .../Marlowe/Runtime/Web/Withdrawal/Put.hs     | 15 ++---
 .../Runtime/Web/Server/REST/ApiError.hs       |  2 +-
 .../Marlowe/Runtime/Transaction/Gen.hs        |  2 +-
 .../Marlowe/Runtime/Transaction/Api.hs        |  2 +-
 .../Runtime/Transaction/BuildConstraints.hs   |  3 +-
 15 files changed, 99 insertions(+), 78 deletions(-)

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
index ac3ab85d01..61490010c8 100644
--- a/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
+++ b/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
@@ -38,6 +38,7 @@ import Data.Coerce (coerce)
 import Data.Foldable (for_)
 import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Time.Units (Microsecond, Second, TimeUnit (fromMicroseconds, toMicroseconds))
 import Data.Traversable (for)
@@ -97,6 +98,8 @@ import Language.Marlowe.Cardano.Thread qualified as Marlowe.Cardano.Thread
 import Language.Marlowe.Core.V1.Merkle (MerkleizedContract (MerkleizedContract), deepMerkleize, merkleizeInputs)
 import Language.Marlowe.Core.V1.Semantics qualified as M
 import Language.Marlowe.Protocol.Client qualified as Marlowe.Protocol
+import Language.Marlowe.Protocol.Query.Client (getPayouts)
+import Language.Marlowe.Protocol.Query.Types (Order (..), Page (..), PayoutFilter (..), PayoutRef (..), Range (..))
 import Language.Marlowe.Runtime.Cardano.Api qualified as MRCA
 import Language.Marlowe.Runtime.Cardano.Api qualified as RCA
 import Language.Marlowe.Runtime.ChainSync.Api qualified as ChainSync
@@ -323,7 +326,17 @@ withdraw ro contractId tokenName walletNickname Wallet{_waAddress, _waSigningKey
             , extraAddresses = mempty
             , collateralUtxos = mempty
             }
-    Marlowe.Class.withdraw MarloweV1 walletAddresses contractId tokenName'
+    let unclaimed = True
+    let contractIds = Set.singleton contractId
+    let roleTokens = mempty
+    let rangeStart = Nothing
+    let rangeOffset = 0
+    let rangeLimit = 100
+    let rangeDirection = Descending
+    Just Page{..} <- Marlowe.Class.runMarloweQueryClient $ getPayouts PayoutFilter{..} $ Range{..}
+    let matchesRole PayoutRef{role} = tokenName' == role
+    let payouts = Set.fromList $ payout <$> filter matchesRole items
+    Marlowe.Class.withdraw MarloweV1 walletAddresses payouts
   case result of
     Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{..}) -> do
       let witness = somePaymentsigningKeyToTxWitness _waSigningKey
diff --git a/marlowe-cli/marlowe-cli.cabal b/marlowe-cli/marlowe-cli.cabal
index 03e0eaf33b..c4be29bf8f 100644
--- a/marlowe-cli/marlowe-cli.cabal
+++ b/marlowe-cli/marlowe-cli.cabal
@@ -194,7 +194,7 @@ library cli-test
     , marlowe-client
     , marlowe-contracts
     , marlowe-protocols
-    , marlowe-runtime:{marlowe-runtime, history-api, proxy-api, tx-api}
+    , marlowe-runtime:{marlowe-runtime, history-api, proxy-api, sync-api, tx-api}
     , monad-loops
     , mtl
     , network
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs
index f15a9c68d6..480b1eab7d 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs
@@ -23,6 +23,7 @@ import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
 import qualified Data.Set as Set
 import Data.String (fromString)
+import qualified Data.Text as T
 import qualified Data.Text as Text
 import qualified Data.Time as Time
 import qualified Data.Time.Clock.POSIX as POSIX
@@ -32,6 +33,7 @@ import qualified Language.Marlowe.Core.V1.Semantics.Types as V1
 import Language.Marlowe.Object.Archive (packArchive)
 import Language.Marlowe.Object.Types (LabelledObject (LabelledObject), ObjectType (ContractType), fromCoreContract)
 import Language.Marlowe.Runtime.Cardano.Api (cardanoEraToAsType)
+import Language.Marlowe.Runtime.ChainSync.Api (renderTxOutRef)
 import qualified Language.Marlowe.Runtime.ChainSync.Api as ChainSync.Api
 import Language.Marlowe.Runtime.Client (runMarloweTxClient)
 import qualified Language.Marlowe.Runtime.Client as Runtime.Client
@@ -41,6 +43,7 @@ import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata (..),
   MarloweVersion (MarloweV1),
   MarloweVersionTag (V1),
+  TransactionOutput (..),
   renderContractId,
  )
 import Language.Marlowe.Runtime.Integration.Common (
@@ -51,6 +54,8 @@ import Language.Marlowe.Runtime.Integration.Common (
  )
 import qualified Language.Marlowe.Runtime.Integration.Common as Runtime.Integration.Common
 import Language.Marlowe.Runtime.Transaction.Api (
+  InputsApplied (..),
+  InputsAppliedInEra (..),
   MarloweTxCommand (..),
   WalletAddresses (..),
   WithdrawTx (..),
@@ -138,41 +143,40 @@ toCliArgs = \case
               <> do address <- Set.toList extraAddresses; ["--address", serializeAddress address]
               <> ["--contract", Text.unpack $ renderContractId contractId]
           _ -> undefined
-  Withdraw MarloweV1 WalletAddresses{changeAddress, extraAddresses} contractId tokenName ->
+  Withdraw MarloweV1 WalletAddresses{changeAddress, extraAddresses} payouts ->
     ["withdraw", "--change-address", serializeAddress changeAddress]
       <> do address <- Set.toList extraAddresses; ["--address", serializeAddress address]
-      <> ["--contract", Text.unpack $ renderContractId contractId]
-      <> ["--role", removeQuotes $ show tokenName]
+      <> (T.unpack . renderTxOutRef <$> Set.toList payouts)
   where
     removeQuotes :: String -> String
     removeQuotes = init . tail
 
-marloweRuntimeJobClient :: MarloweTxCommand Void err result -> Integration (TxBody BabbageEra)
+marloweRuntimeJobClient :: MarloweTxCommand Void err result -> Integration (TxBody BabbageEra, result)
 marloweRuntimeJobClient = \case
   cmd@(Create _ MarloweV1 _ _ _ _ _) ->
     runMarloweTxClient (JobClient.liftCommand cmd) >>= \case
       Left err -> error ("Some JobClient create error: " <> show err)
       Right
-        ( Runtime.Transaction.Api.ContractCreated
-            ReferenceTxInsScriptsInlineDatumsInBabbageEra
-            Runtime.Transaction.Api.ContractCreatedInEra{txBody}
-          ) -> pure txBody
+        result@( Runtime.Transaction.Api.ContractCreated
+                  ReferenceTxInsScriptsInlineDatumsInBabbageEra
+                  Runtime.Transaction.Api.ContractCreatedInEra{txBody}
+                ) -> pure (txBody, result)
   cmd@(ApplyInputs MarloweV1 _ _ _ _ _ _) ->
     runMarloweTxClient (JobClient.liftCommand cmd) >>= \case
       Left err -> error ("Some JobClient input error: " <> show err)
       Right
-        ( Runtime.Transaction.Api.InputsApplied
-            ReferenceTxInsScriptsInlineDatumsInBabbageEra
-            Runtime.Transaction.Api.InputsAppliedInEra{txBody}
-          ) -> pure txBody
-  cmd@(Withdraw MarloweV1 _ _ _) ->
+        result@( Runtime.Transaction.Api.InputsApplied
+                  ReferenceTxInsScriptsInlineDatumsInBabbageEra
+                  Runtime.Transaction.Api.InputsAppliedInEra{txBody}
+                ) -> pure (txBody, result)
+  cmd@(Withdraw MarloweV1 _ _) ->
     runMarloweTxClient (JobClient.liftCommand cmd) >>= \case
       Left err -> error ("Some JobClient withdraw error: " <> show err)
       Right
-        ( Runtime.Transaction.Api.WithdrawTx
-            ReferenceTxInsScriptsInlineDatumsInBabbageEra
-            Runtime.Transaction.Api.WithdrawTxInEra{txBody}
-          ) -> pure txBody
+        result@( Runtime.Transaction.Api.WithdrawTx
+                  ReferenceTxInsScriptsInlineDatumsInBabbageEra
+                  Runtime.Transaction.Api.WithdrawTxInEra{txBody}
+                ) -> pure (txBody, result)
 
 expectSameResultFromCLIAndJobClient :: String -> [String] -> MarloweTxCommand Void err result -> Integration ()
 expectSameResultFromCLIAndJobClient outputFile extraCliArgs command = do
@@ -188,7 +192,7 @@ expectSameResultFromCLIAndJobClient outputFile extraCliArgs command = do
 
       jobClientEffect :: Integration (TxBody BabbageEra)
       jobClientEffect =
-        either (error . show) id . deserialiseFromCBOR (AsTxBody AsBabbageEra) . serialiseToCBOR
+        either (error . show) id . deserialiseFromCBOR (AsTxBody AsBabbageEra) . serialiseToCBOR . fst
           <$> marloweRuntimeJobClient command
 
   (_, expected) <- concurrently cliEffect jobClientEffect
@@ -265,7 +269,7 @@ createSpec = describe "create" $
         creationCommand
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.CreateError 'V1)
+              Runtime.Transaction.Api.CreateError
               (Runtime.Transaction.Api.ContractCreated 'V1)
         creationCommand =
           Create
@@ -322,7 +326,7 @@ depositSpec = describe "deposit" $
         command
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.ApplyInputsError 'V1)
+              Runtime.Transaction.Api.ApplyInputsError
               (Runtime.Transaction.Api.InputsApplied 'V1)
         command =
           ApplyInputs
@@ -379,7 +383,7 @@ chooseSpec = describe "choose" $
         command
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.ApplyInputsError 'V1)
+              Runtime.Transaction.Api.ApplyInputsError
               (Runtime.Transaction.Api.InputsApplied 'V1)
         command =
           ApplyInputs
@@ -433,7 +437,7 @@ notifySpec = describe "notify" $
         command
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.ApplyInputsError 'V1)
+              Runtime.Transaction.Api.ApplyInputsError
               (Runtime.Transaction.Api.InputsApplied 'V1)
         command =
           ApplyInputs
@@ -514,7 +518,7 @@ applySpec = describe "apply" $
         command
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.ApplyInputsError 'V1)
+              Runtime.Transaction.Api.ApplyInputsError
               (Runtime.Transaction.Api.InputsApplied 'V1)
         command =
           ApplyInputs
@@ -569,7 +573,7 @@ withdrawSpec = describe "withdraw" $
         depositCommand
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.ApplyInputsError 'V1)
+              Runtime.Transaction.Api.ApplyInputsError
               (Runtime.Transaction.Api.InputsApplied 'V1)
         depositCommand =
           ApplyInputs
@@ -581,21 +585,24 @@ withdrawSpec = describe "withdraw" $
             Nothing
             [V1.NormalInput $ V1.IDeposit partyA partyA ada 100_000_000]
 
-    _ <- Runtime.Integration.Common.submit partyAWallet =<< marloweRuntimeJobClient depositCommand
+    (depositTxBody, InputsApplied ReferenceTxInsScriptsInlineDatumsInBabbageEra InputsAppliedInEra{output}) <-
+      marloweRuntimeJobClient depositCommand
+
+    _ <- Runtime.Integration.Common.submit partyAWallet depositTxBody
 
     let extraCliArgs = []
 
         command
           :: MarloweTxCommand
               Void
-              (Runtime.Transaction.Api.WithdrawError 'V1)
+              Runtime.Transaction.Api.WithdrawError
               (WithdrawTx 'V1)
         command =
           Withdraw
             MarloweV1
             addresses
-            contractId
-            "Party A"
+            $ Map.keysSet
+            $ payouts output
 
     expectSameResultFromCLIAndJobClient "withdraw-tx-body.json" extraCliArgs command
 
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs
index d146f813cf..dd82cffc04 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Common.hs
@@ -49,6 +49,7 @@ import Data.Function (on)
 import Data.Functor (($>))
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes, fromJust)
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.String (fromString)
 import qualified Data.Text as T
@@ -75,8 +76,8 @@ import Language.Marlowe.Runtime.ChainSync.Api (
   BlockNo (..),
   Lovelace,
   SlotNo (..),
-  TokenName,
   TxId,
+  TxOutRef,
   fromBech32,
  )
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
@@ -418,11 +419,10 @@ notify Wallet{..} contractId = do
 
 withdraw
   :: Wallet
-  -> ContractId
-  -> TokenName
+  -> Set TxOutRef
   -> Integration (WithdrawTxInEra BabbageEra 'V1)
-withdraw Wallet{..} contractId role = do
-  result <- Client.withdraw MarloweV1 addresses contractId role
+withdraw Wallet{..} payouts = do
+  result <- Client.withdraw MarloweV1 addresses payouts
   WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra tx <-
     expectRight "Failed to create withdraw transaction" result
   pure tx
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Create.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Create.hs
index 4f4d3887e4..34022be1c7 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Create.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Create.hs
@@ -90,7 +90,7 @@ expectSuccess action = \case
   (a, Right b) -> action (a, b)
 
 runCreateCase
-  :: CreateCase -> ActionWith (TestData, Either (CreateError 'V1) (ContractCreated 'V1)) -> ActionWith TestData
+  :: CreateCase -> ActionWith (TestData, Either CreateError (ContractCreated 'V1)) -> ActionWith TestData
 runCreateCase createCase action testData = flip runIntegrationTest (runtime testData) do
   result <- runMarloweTxClient $ liftCommand $ mkCreateCommand testData createCase
   liftIO $ action (testData, result)
@@ -332,7 +332,7 @@ minLovelaceSpec = \case
   MinLovelaceSufficient -> Just $ pure ()
   MinLovelaceInsufficient -> Nothing
 
-mkCreateCommand :: TestData -> CreateCase -> MarloweTxCommand Void (CreateError 'V1) (ContractCreated 'V1)
+mkCreateCommand :: TestData -> CreateCase -> MarloweTxCommand Void CreateError (ContractCreated 'V1)
 mkCreateCommand testData (CreateCase stakeCredential wallet (roleTokens, metadata) minLovelace) =
   Create
     (mkStakeCredential testData stakeCredential)
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/StandardContract.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/StandardContract.hs
index bc9df9bfeb..e1b4e4c648 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/StandardContract.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/StandardContract.hs
@@ -26,6 +26,7 @@ import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata (..),
   MarloweVersion (..),
   MarloweVersionTag (..),
+  TransactionOutput (..),
   emptyMarloweTransactionMetadata,
  )
 import Language.Marlowe.Runtime.Discovery.Api (ContractHeader)
@@ -167,7 +168,7 @@ createStandardContractWithTags tags partyAWallet partyBWallet = do
                               { notifiedBlock
                               , notified
                               , makeReturnDeposit = do
-                                  returnDeposited@InputsAppliedInEra{txBody = returnTxBody} <-
+                                  returnDeposited@InputsAppliedInEra{txBody = returnTxBody, output} <-
                                     deposit
                                       partyBWallet
                                       contractId
@@ -182,7 +183,8 @@ createStandardContractWithTags tags partyAWallet partyBWallet = do
                                       { returnDepositBlock
                                       , returnDeposited
                                       , withdrawPartyAFunds = do
-                                          withdrawTx@WithdrawTxInEra{txBody = withdrawTxBody} <- withdraw partyAWallet contractId "Party A"
+                                          withdrawTx@WithdrawTxInEra{txBody = withdrawTxBody} <-
+                                            withdraw partyAWallet $ Map.keysSet $ payouts output
                                           (withdrawTx,) <$> submit partyAWallet withdrawTxBody
                                       }
                               }
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
index 2d41c215f0..2aea8dad2b 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
@@ -9,12 +9,13 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Marlowe.Class (withdraw)
 import qualified Data.Map as Map
 import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..), Assets (Assets))
-import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..), Payout (Payout))
+import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..), Payout (Payout), TransactionOutput (..))
 import Language.Marlowe.Runtime.Integration.Common (Wallet (..), expectRight, getGenesisWallet, runIntegrationTest)
 import Language.Marlowe.Runtime.Integration.StandardContract
 import Language.Marlowe.Runtime.Transaction.Api (
   ConstraintError (RoleTokenNotFound),
   ContractCreatedInEra (..),
+  InputsAppliedInEra (..),
   WithdrawError (..),
   WithdrawTx (..),
   WithdrawTxInEra (..),
@@ -36,8 +37,9 @@ missingRoleTokenTest = withLocalMarloweRuntime $ runIntegrationTest do
   step2 <- makeInitialDeposit step1
   step3 <- chooseGimmeTheMoney step2
   step4 <- sendNotify step3
-  _ <- makeReturnDeposit step4
-  result <- case contractCreated step1 of ContractCreatedInEra{..} -> withdraw MarloweV1 (addresses wallet2) contractId "Party A"
+  StandardContractClosed{returnDeposited = InputsAppliedInEra{output}} <- makeReturnDeposit step4
+  let TransactionOutput{payouts} = output
+  result <- withdraw MarloweV1 (addresses wallet2) $ Map.keysSet payouts
   let policyId = case contractCreated step1 of ContractCreatedInEra{..} -> rolesCurrency
   liftIO $ result `shouldBe` Left (WithdrawConstraintError $ RoleTokenNotFound $ AssetId policyId "Party A")
 
@@ -49,8 +51,8 @@ noPayoutsTest = withLocalMarloweRuntime $ runIntegrationTest do
   step2 <- makeInitialDeposit step1
   step3 <- chooseGimmeTheMoney step2
   _ <- sendNotify step3
-  result <- case contractCreated step1 of ContractCreatedInEra{..} -> withdraw MarloweV1 (addresses wallet1) contractId "Party A"
-  liftIO $ result `shouldBe` Left (UnableToFindPayoutForAGivenRole "Party A")
+  result <- withdraw MarloweV1 (addresses wallet1) mempty
+  liftIO $ result `shouldBe` Left EmptyPayouts
 
 payoutsTest :: IO ()
 payoutsTest = withLocalMarloweRuntime $ runIntegrationTest do
@@ -61,8 +63,9 @@ payoutsTest = withLocalMarloweRuntime $ runIntegrationTest do
   step2 <- makeInitialDeposit
   step3 <- chooseGimmeTheMoney step2
   step4 <- sendNotify step3
-  _ <- makeReturnDeposit step4
-  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{inputs, roleToken = AssetId{..}} <-
-    expectRight "failed to withdraw payouts" =<< withdraw MarloweV1 (addresses wallet1) contractId "Party A"
-  liftIO $ tokenName `shouldBe` "Party A"
-  liftIO $ Map.elems inputs `shouldBe` [Payout payoutScriptAddress (Assets 100_000_000 mempty) AssetId{..}]
+  StandardContractClosed{returnDeposited = InputsAppliedInEra{output}} <- makeReturnDeposit step4
+  let TransactionOutput{payouts} = output
+  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{inputs} <-
+    expectRight "failed to withdraw payouts" =<< withdraw MarloweV1 (addresses wallet1) (Map.keysSet payouts)
+  liftIO $
+    Map.elems inputs `shouldBe` [Payout payoutScriptAddress (Assets 100_000_000 mempty) $ AssetId rolesCurrency "Party A"]
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
index efb2b48cf9..3e069607f9 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
@@ -25,6 +25,7 @@ import Cardano.Api (
 import Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr (..))
 import Control.Concurrent (threadDelay)
 import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Language.Marlowe as V1
@@ -166,10 +167,9 @@ notify wallet contractId = applyInputs wallet contractId [NormalInput INotify]
 
 withdraw
   :: Wallet
-  -> Web.TxOutRef
-  -> T.Text
+  -> Set Web.TxOutRef
   -> ClientM (Web.WithdrawTxEnvelope Web.CardanoTxBody)
-withdraw Wallet{..} contractId role = do
+withdraw Wallet{..} payouts = do
   let WalletAddresses{..} = addresses
   let webChangeAddress = toDTO changeAddress
   let webExtraAddresses = Set.map toDTO extraAddresses
@@ -180,8 +180,7 @@ withdraw Wallet{..} contractId role = do
     (Just webExtraAddresses)
     (Just webCollateralUtxos)
     Web.PostWithdrawalsRequest
-      { role
-      , contractId
+      { payouts
       }
 applyInputs
   :: Wallet
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
index 7ce03ac3d1..3fe2c138c4 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
@@ -25,11 +25,12 @@ import Language.Marlowe.Runtime.Web (
   CardanoTxBody,
   ContractOrSourceId (..),
   CreateTxEnvelope,
+  PayoutRef (..),
   RoleTokenConfig (RoleTokenSimple),
   WithdrawTxEnvelope,
  )
 import qualified Language.Marlowe.Runtime.Web as Web
-import Language.Marlowe.Runtime.Web.Client (postContract, postContractSource)
+import Language.Marlowe.Runtime.Web.Client (Page (..), getPayouts, postContract, postContractSource)
 import Language.Marlowe.Runtime.Web.Common (
   choose,
   deposit,
@@ -168,7 +169,9 @@ createStandardContractWithTags tags partyAWallet partyBWallet = do
                                       { returnDepositBlock
                                       , returnDeposited
                                       , withdrawPartyAFunds = do
-                                          withdrawTxBody <- withdraw partyAWallet contractId "Party A"
+                                          Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
+                                          let payouts = Set.fromList $ payout <$> items
+                                          withdrawTxBody <- withdraw partyAWallet payouts
                                           (withdrawTxBody,) <$> submitWithdrawal partyAWallet withdrawTxBody
                                       }
                               }
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
index 656c708545..207e020671 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
@@ -4,8 +4,9 @@ import Data.Functor (void)
 import qualified Data.Set as Set
 import Language.Marlowe.Runtime.Integration.Common
 import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..))
+import Language.Marlowe.Runtime.Web (PayoutRef (..))
 import qualified Language.Marlowe.Runtime.Web as Web
-import Language.Marlowe.Runtime.Web.Client (postWithdrawal)
+import Language.Marlowe.Runtime.Web.Client (Page (..), getPayouts, postWithdrawal)
 import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO (toDTO))
 import Language.Marlowe.Runtime.Web.StandardContract (
   StandardContractChoiceMade (..),
@@ -37,15 +38,10 @@ spec = describe "POST /contracts/{contractId}/withdrawal" do
       StandardContractClosed{} <- makeReturnDeposit
       contractId <- case contractCreated of
         Web.CreateTxEnvelope{contractId} -> pure contractId
+      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
+      let payouts = Set.fromList $ payout <$> items
       void $
-        postWithdrawal
-          webChangeAddress
-          (Just webExtraAddresses)
-          (Just webCollataralUtxos)
-          Web.PostWithdrawalsRequest
-            { role = "Party A"
-            , contractId
-            }
+        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollataralUtxos) Web.PostWithdrawalsRequest{..}
 
     case result of
       Left _ -> fail $ "Expected 200 response code - got " <> show result
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
index 80db292162..da838ed833 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
@@ -4,8 +4,9 @@ import Control.Monad.IO.Class (MonadIO (liftIO))
 import qualified Data.Set as Set
 import Language.Marlowe.Runtime.Integration.Common
 import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..))
+import Language.Marlowe.Runtime.Web (PayoutRef (..))
 import qualified Language.Marlowe.Runtime.Web as Web
-import Language.Marlowe.Runtime.Web.Client (postWithdrawal, putWithdrawal)
+import Language.Marlowe.Runtime.Web.Client (Page (..), getPayouts, postWithdrawal, putWithdrawal)
 import Language.Marlowe.Runtime.Web.Common (signShelleyTransaction')
 import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO (toDTO))
 import Language.Marlowe.Runtime.Web.StandardContract (
@@ -39,15 +40,11 @@ spec = describe "PUT /contracts/{contractId}/withdrawals/{withdrawalId}" do
       contractId <- case contractCreated of
         Web.CreateTxEnvelope{contractId} -> pure contractId
 
+      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
+      let payouts = Set.fromList $ payout <$> items
+
       Web.WithdrawTxEnvelope{withdrawalId, txEnvelope} <-
-        postWithdrawal
-          webChangeAddress
-          (Just webExtraAddresses)
-          (Just webCollataralUtxos)
-          Web.PostWithdrawalsRequest
-            { role = "Party A"
-            , contractId
-            }
+        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollataralUtxos) Web.PostWithdrawalsRequest{..}
       signedWithdrawalTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
       putWithdrawal withdrawalId signedWithdrawalTx
 
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
index 88a848bcca..899f15dbfd 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/ApiError.hs
@@ -122,7 +122,7 @@ instance ToDTO WithdrawError where
       PayoutNotFound _ -> 400
       CoinSelectionFailed _ -> 400
       _ -> 500
-    UnableToFindPayoutForAGivenRole _ -> ApiError "No payouts available for given role" "UnableToFindPayoutForAGivenRole" Null 409
+    EmptyPayouts -> ApiError "Empty payouts" "EmptyPayouts" Null 400
 
 instance HasDTO CreateError where
   type DTO CreateError = ApiError
diff --git a/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs b/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
index 5f8a3997c4..76bd506bb5 100644
--- a/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
+++ b/marlowe-runtime/gen/Language/Marlowe/Runtime/Transaction/Gen.hs
@@ -198,7 +198,7 @@ instance Arbitrary WithdrawError where
     oneof
       [ WithdrawConstraintError <$> arbitrary
       , WithdrawEraUnsupported <$> arbitrary
-      , UnableToFindPayoutForAGivenRole <$> arbitrary
+      , pure EmptyPayouts
       ]
   shrink = genericShrink
 
diff --git a/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs b/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
index e9484c754b..a1c36ee403 100644
--- a/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
+++ b/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
@@ -866,7 +866,7 @@ data ApplyInputsConstraintsBuildupError
 data WithdrawError
   = WithdrawEraUnsupported AnyCardanoEra
   | WithdrawConstraintError ConstraintError
-  | UnableToFindPayoutForAGivenRole TokenName
+  | EmptyPayouts
   deriving (Generic)
 
 deriving instance Eq WithdrawError
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
index e2b25e1e7c..a8f9e19fb2 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs
@@ -15,7 +15,7 @@ import qualified Cardano.Api.Shelley as C
 import qualified Cardano.Ledger.BaseTypes as CL (Network (..))
 import Control.Category ((>>>))
 import Control.Error (ExceptT, note)
-import Control.Monad (unless, (>=>))
+import Control.Monad (unless, when, (>=>))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (except, throwE, withExceptT)
 import Control.Monad.Trans.Writer (WriterT (runWriterT), tell)
@@ -535,6 +535,7 @@ buildWithdrawConstraints TxConstraints.PayoutContext{..} = \case
     buildWithdrawConstraintsV1
       :: Set TxOutRef -> ExceptT WithdrawError m (Map TxOutRef (Payout 'V1), TxConstraints era 'V1)
     buildWithdrawConstraintsV1 payouts = runWriterT do
+      when (Set.null payouts) $ lift $ throwE EmptyPayouts
       let payoutsList = Set.toAscList payouts
       traverse_ (tell . TxConstraints.mustConsumePayout) payoutsList
       Map.fromDistinctAscList <$> for payoutsList \payoutRef -> do

From c35b68909024fec0f2fb4a8d9481aefbbeb60009 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 16:16:16 -0600
Subject: [PATCH 05/10] Fix marlowe context query

---
 .../Runtime/ChainSync/Database/PostgreSQL.hs  | 77 ++++++++++---------
 .../Marlowe/Runtime/Transaction/Query.hs      |  2 +-
 2 files changed, 41 insertions(+), 38 deletions(-)

diff --git a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL.hs b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL.hs
index 1247b67445..211ed02043 100644
--- a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL.hs
+++ b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Database/PostgreSQL.hs
@@ -897,48 +897,51 @@ getUTxOs =
             txOutRefs' = (V.fromList *** V.fromList) . unzip . fmap txOutRefTuple . Set.toList $ txOutRefs
         HT.statement txOutRefs' $
           [foldStatement|
-        SELECT txOut.txId :: bytea
-             , txOut.txIx :: smallint
-             , txOut.address :: bytea
-             , txOut.lovelace :: bigint
-             , txOut.datumHash :: bytea?
-             , txOut.datumBytes :: bytea?
-             , asset.policyId :: bytea?
-             , asset.name :: bytea?
-             , assetOut.quantity :: bigint?
-          FROM chain.txOut         AS txOut
-          LEFT JOIN chain.txIn     AS txIn     ON txIn.txOutId = txOut.txId AND txIn.txOutIx = txOut.txIx
-          LEFT JOIN chain.assetOut AS assetOut ON assetOut.txOutId = txOut.txId AND assetOut.txOutIx = txOut.txIx
-          LEFT JOIN chain.asset    AS asset    ON asset.id = assetOut.assetId
-         WHERE (txOut.txId, txOut.txTx) = ANY(unnest ($1 :: bytea[], $2 :: smallint[]))
-           AND txIn.txInId IS NULL
-         ORDER BY txIx
-      |]
+            WITH txOuts (txId, txIx) AS
+              ( SELECT * FROM UNNEST($1 :: bytea[], $2 :: smallint[])
+              )
+            SELECT txOut.txId :: bytea
+                , txOut.txIx :: smallint
+                , txOut.address :: bytea
+                , txOut.lovelace :: bigint
+                , txOut.datumHash :: bytea?
+                , txOut.datumBytes :: bytea?
+                , asset.policyId :: bytea?
+                , asset.name :: bytea?
+                , assetOut.quantity :: bigint?
+              FROM chain.txOut         AS txOut
+              NATURAL JOIN txOuts
+              LEFT JOIN chain.txIn     AS txIn     ON txIn.txOutId = txOut.txId AND txIn.txOutIx = txOut.txIx
+              LEFT JOIN chain.assetOut AS assetOut ON assetOut.txOutId = txOut.txId AND assetOut.txOutIx = txOut.txIx
+              LEFT JOIN chain.asset    AS asset    ON asset.id = assetOut.assetId
+            WHERE txIn.txInId IS NULL
+            ORDER BY txIx
+          |]
             (Fold foldRow mempty id)
       GetUTxOsAtAddresses addresses -> do
         let addresses' = V.fromList $ fmap unAddress . Set.toList $ addresses
         HT.statement addresses' $
           [foldStatement|
-        WITH addresses (address) AS
-          ( SELECT * FROM UNNEST($1 :: bytea[])
-          )
-        SELECT txOut.txId :: bytea
-             , txOut.txIx :: smallint
-             , txOut.address :: bytea
-             , txOut.lovelace :: bigint
-             , txOut.datumHash :: bytea?
-             , txOut.datumBytes :: bytea?
-             , asset.policyId :: bytea?
-             , asset.name :: bytea?
-             , assetOut.quantity :: bigint?
-          FROM chain.txOut         AS txOut
-          JOIN addresses           AS addr     ON addr.address = txOut.address AND CAST(MD5(addr.address) AS uuid) = CAST(MD5(txOut.address) AS uuid)
-          LEFT JOIN chain.txIn     AS txIn     ON txIn.txOutId = txOut.txId AND txIn.txOutIx = txOut.txIx
-          LEFT JOIN chain.assetOut AS assetOut ON assetOut.txOutId = txOut.txId AND assetOut.txOutIx = txOut.txIx
-          LEFT JOIN chain.asset    AS asset    ON asset.id = assetOut.assetId
-         WHERE txIn.txInId IS NULL
-         ORDER BY txIx
-      |]
+            WITH addresses (address) AS
+              ( SELECT * FROM UNNEST($1 :: bytea[])
+              )
+            SELECT txOut.txId :: bytea
+                , txOut.txIx :: smallint
+                , txOut.address :: bytea
+                , txOut.lovelace :: bigint
+                , txOut.datumHash :: bytea?
+                , txOut.datumBytes :: bytea?
+                , asset.policyId :: bytea?
+                , asset.name :: bytea?
+                , assetOut.quantity :: bigint?
+              FROM chain.txOut         AS txOut
+              JOIN addresses           AS addr     ON addr.address = txOut.address AND CAST(MD5(addr.address) AS uuid) = CAST(MD5(txOut.address) AS uuid)
+              LEFT JOIN chain.txIn     AS txIn     ON txIn.txOutId = txOut.txId AND txIn.txOutIx = txOut.txIx
+              LEFT JOIN chain.assetOut AS assetOut ON assetOut.txOutId = txOut.txId AND assetOut.txOutIx = txOut.txIx
+              LEFT JOIN chain.asset    AS asset    ON asset.id = assetOut.assetId
+            WHERE txIn.txInId IS NULL
+            ORDER BY txIx
+          |]
             (Fold foldRow mempty id)
   where
     foldRow acc (txId, txIx, address, lovelace, datumHash, datumBytes, policyId, tokenName, quantity) =
diff --git a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
index 446ea5c345..9fe0a1ee09 100644
--- a/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
+++ b/marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Query.hs
@@ -243,7 +243,7 @@ loadMarloweContext getScripts networkId chainSyncConnector chainSyncQueryConnect
       -> NonEmpty (BlockHeader, MarloweContext v)
       -> ClientStIdle Move ChainPoint ChainPoint m (Either LoadMarloweContextError (MarloweContext v))
     clientFollowContract version contexts = case scriptUtxo of
-      Nothing -> SendMsgDone $ Right context
+      Nothing -> SendMsgDone $ Left LoadMarloweContextErrorNotFound
       Just lastOutput ->
         SendMsgQueryNext
           (FindConsumingTxs $ Set.singleton lastOutput)

From d4474a89aaa143883a1821645e3d59d6f59dfd90 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 22 Aug 2023 16:18:25 -0600
Subject: [PATCH 06/10] Update changelog

---
 .../20230822_161710_jhbertra_plt_6847_withdraw_by_payout.md  | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 marlowe-runtime/changelog.d/20230822_161710_jhbertra_plt_6847_withdraw_by_payout.md

diff --git a/marlowe-runtime/changelog.d/20230822_161710_jhbertra_plt_6847_withdraw_by_payout.md b/marlowe-runtime/changelog.d/20230822_161710_jhbertra_plt_6847_withdraw_by_payout.md
new file mode 100644
index 0000000000..cba8c66134
--- /dev/null
+++ b/marlowe-runtime/changelog.d/20230822_161710_jhbertra_plt_6847_withdraw_by_payout.md
@@ -0,0 +1,5 @@
+### Changed
+
+- BREAKING `Withdraw` now accepts a set of payout tx outs instead of a contract
+  ID and a role token. The old behaviour can be emulated via a query to fetch
+  unclaimed payouts for a contract.

From 15b9f27389672922a7770ff55f4f0e2141823378 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Wed, 23 Aug 2023 10:31:26 -0600
Subject: [PATCH 07/10] Change payout schema to be more consistent

---
 .../Marlowe/CLI/Test/Runtime/Interpret.hs     |   9 +-
 .../Runtime/Integration/MarloweQuery.hs       |  47 ++++----
 .../Marlowe/Runtime/Web/StandardContract.hs   |   7 +-
 .../Marlowe/Runtime/Web/Withdrawal/Post.hs    |  10 +-
 .../Marlowe/Runtime/Web/Withdrawal/Put.hs     |  11 +-
 .../Marlowe/Runtime/Web/Server/DTO.hs         |  33 +++---
 .../Runtime/Web/Server/REST/Payouts.hs        |  13 ++-
 .../Marlowe/Runtime/Web/Server/SyncClient.hs  |   4 +-
 .../src/Language/Marlowe/Runtime/Web/API.hs   |  12 +-
 .../Language/Marlowe/Runtime/Web/Client.hs    |   8 +-
 .../src/Language/Marlowe/Runtime/Web/Types.hs | 108 ++++++++++++------
 marlowe-runtime-web/test/Spec.hs              |  14 ++-
 .../Language/Marlowe/Protocol/Query/Client.hs |   2 +-
 .../Language/Marlowe/Protocol/Query/Server.hs |   2 +-
 .../Language/Marlowe/Protocol/Query/Types.hs  |  25 ++--
 .../Language/Marlowe/Runtime/Sync/Database.hs |   6 +-
 .../Sync/Database/PostgreSQL/GetPayouts.hs    |  55 ++++++---
 .../Sync/Database/PostgreSQL/GetWithdrawal.hs |  19 +--
 .../Language/Marlowe/Protocol/QuerySpec.hs    |   4 +-
 19 files changed, 233 insertions(+), 156 deletions(-)

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
index 61490010c8..d2e6c691b2 100644
--- a/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
+++ b/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
@@ -99,9 +99,10 @@ import Language.Marlowe.Core.V1.Merkle (MerkleizedContract (MerkleizedContract),
 import Language.Marlowe.Core.V1.Semantics qualified as M
 import Language.Marlowe.Protocol.Client qualified as Marlowe.Protocol
 import Language.Marlowe.Protocol.Query.Client (getPayouts)
-import Language.Marlowe.Protocol.Query.Types (Order (..), Page (..), PayoutFilter (..), PayoutRef (..), Range (..))
+import Language.Marlowe.Protocol.Query.Types (Order (..), Page (..), PayoutFilter (..), PayoutHeader (..), Range (..))
 import Language.Marlowe.Runtime.Cardano.Api qualified as MRCA
 import Language.Marlowe.Runtime.Cardano.Api qualified as RCA
+import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..))
 import Language.Marlowe.Runtime.ChainSync.Api qualified as ChainSync
 import Language.Marlowe.Runtime.Core.Api (
   ContractId,
@@ -326,7 +327,7 @@ withdraw ro contractId tokenName walletNickname Wallet{_waAddress, _waSigningKey
             , extraAddresses = mempty
             , collateralUtxos = mempty
             }
-    let unclaimed = True
+    let isWithdrawn = Just False
     let contractIds = Set.singleton contractId
     let roleTokens = mempty
     let rangeStart = Nothing
@@ -334,8 +335,8 @@ withdraw ro contractId tokenName walletNickname Wallet{_waAddress, _waSigningKey
     let rangeLimit = 100
     let rangeDirection = Descending
     Just Page{..} <- Marlowe.Class.runMarloweQueryClient $ getPayouts PayoutFilter{..} $ Range{..}
-    let matchesRole PayoutRef{role} = tokenName' == role
-    let payouts = Set.fromList $ payout <$> filter matchesRole items
+    let matchesRole PayoutHeader{role = AssetId{tokenName = roleName}} = tokenName' == roleName
+    let payouts = Set.fromList $ payoutId <$> filter matchesRole items
     Marlowe.Class.withdraw MarloweV1 walletAddresses payouts
   case result of
     Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{..}) -> do
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs
index 7b9c4982c1..93539e17f5 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs
@@ -29,7 +29,7 @@ import Language.Marlowe.Protocol.Query.Client (
  )
 import Language.Marlowe.Protocol.Query.Types
 import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
-import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..), BlockHeader, PolicyId, TxId, TxOutRef (..))
+import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, PolicyId, TxId, TxOutRef (..))
 import Language.Marlowe.Runtime.Client (runMarloweQueryClient)
 import Language.Marlowe.Runtime.Core.Api (
   ContractId (..),
@@ -139,26 +139,24 @@ instance PaginatedQuery GetWithdrawals where
         Withdrawal1 -> case contract1Step5 of
           (WithdrawTxInEra{txBody = txBody', ..}, block') ->
             ( (txBody', block')
-            , flip Map.mapWithKey inputs \payout Payout{..} -> case datum of
-                AssetId{..} ->
-                  PayoutRef
-                    { contractId = standardContractId contract1
-                    , payout
-                    , rolesCurrency = policyId
-                    , role = tokenName
-                    }
+            , flip Map.mapWithKey inputs \payoutId Payout{..} ->
+                PayoutHeader
+                  { contractId = standardContractId contract1
+                  , withdrawalId = Just $ fromCardanoTxId $ getTxId txBody'
+                  , payoutId
+                  , role = datum
+                  }
             )
         Withdrawal2 -> case contract2Step5 of
           (WithdrawTxInEra{txBody = txBody', ..}, block') ->
             ( (txBody', block')
-            , flip Map.mapWithKey inputs \payout Payout{..} -> case datum of
-                AssetId{..} ->
-                  PayoutRef
-                    { contractId = standardContractId contract2
-                    , payout
-                    , rolesCurrency = policyId
-                    , role = tokenName
-                    }
+            , flip Map.mapWithKey inputs \payoutId Payout{..} ->
+                PayoutHeader
+                  { contractId = standardContractId contract2
+                  , withdrawalId = Just $ fromCardanoTxId $ getTxId txBody'
+                  , payoutId
+                  , role = datum
+                  }
             )
   toFilter _ MarloweQueryTestData{..} WithdrawalFilterSym{..} =
     WithdrawalFilter
@@ -640,14 +638,13 @@ contract1Step5Withdrawal MarloweQueryTestData{..} =
   Withdrawal
     { block = snd contract1Step5
     , withdrawnPayouts = case fst contract1Step5 of
-        WithdrawTxInEra{..} -> flip Map.mapWithKey inputs \payout Payout{..} -> case datum of
-          AssetId{..} ->
-            PayoutRef
-              { contractId = standardContractId contract1
-              , payout
-              , rolesCurrency = policyId
-              , role = tokenName
-              }
+        WithdrawTxInEra{..} -> flip Map.mapWithKey inputs \payoutId Payout{..} ->
+          PayoutHeader
+            { contractId = standardContractId contract1
+            , withdrawalId = Just $ fromCardanoTxId $ getTxId txBody
+            , payoutId
+            , role = datum
+            }
     , withdrawalTx = fromCardanoTxId $ getTxId $ case fst contract1Step5 of WithdrawTxInEra{txBody} -> txBody
     }
 
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
index 3fe2c138c4..58f6e319e2 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
@@ -25,7 +25,8 @@ import Language.Marlowe.Runtime.Web (
   CardanoTxBody,
   ContractOrSourceId (..),
   CreateTxEnvelope,
-  PayoutRef (..),
+  PayoutHeader (..),
+  PayoutStatus (..),
   RoleTokenConfig (RoleTokenSimple),
   WithdrawTxEnvelope,
  )
@@ -169,8 +170,8 @@ createStandardContractWithTags tags partyAWallet partyBWallet = do
                                       { returnDepositBlock
                                       , returnDeposited
                                       , withdrawPartyAFunds = do
-                                          Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
-                                          let payouts = Set.fromList $ payout <$> items
+                                          Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing (Just Available) Nothing
+                                          let payouts = Set.fromList $ payoutId <$> items
                                           withdrawTxBody <- withdraw partyAWallet payouts
                                           (withdrawTxBody,) <$> submitWithdrawal partyAWallet withdrawTxBody
                                       }
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
index 207e020671..f88ebb53c9 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Post.hs
@@ -4,7 +4,7 @@ import Data.Functor (void)
 import qualified Data.Set as Set
 import Language.Marlowe.Runtime.Integration.Common
 import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..))
-import Language.Marlowe.Runtime.Web (PayoutRef (..))
+import Language.Marlowe.Runtime.Web (PayoutHeader (..), PayoutStatus (..))
 import qualified Language.Marlowe.Runtime.Web as Web
 import Language.Marlowe.Runtime.Web.Client (Page (..), getPayouts, postWithdrawal)
 import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO (toDTO))
@@ -29,7 +29,7 @@ spec = describe "POST /contracts/{contractId}/withdrawal" do
       let WalletAddresses{..} = addresses partyAWallet
       let webChangeAddress = toDTO changeAddress
       let webExtraAddresses = Set.map toDTO extraAddresses
-      let webCollataralUtxos = Set.map toDTO collateralUtxos
+      let webCollateralUtxos = Set.map toDTO collateralUtxos
 
       StandardContractInit{contractCreated, makeInitialDeposit} <- createStandardContract partyAWallet partyBWallet
       StandardContractFundsDeposited{chooseGimmeTheMoney} <- makeInitialDeposit
@@ -38,10 +38,10 @@ spec = describe "POST /contracts/{contractId}/withdrawal" do
       StandardContractClosed{} <- makeReturnDeposit
       contractId <- case contractCreated of
         Web.CreateTxEnvelope{contractId} -> pure contractId
-      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
-      let payouts = Set.fromList $ payout <$> items
+      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing (Just Available) Nothing
+      let payouts = Set.fromList $ payoutId <$> items
       void $
-        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollataralUtxos) Web.PostWithdrawalsRequest{..}
+        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollateralUtxos) Web.PostWithdrawalsRequest{..}
 
     case result of
       Left _ -> fail $ "Expected 200 response code - got " <> show result
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
index da838ed833..f1b5cb9b6d 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
@@ -4,7 +4,7 @@ import Control.Monad.IO.Class (MonadIO (liftIO))
 import qualified Data.Set as Set
 import Language.Marlowe.Runtime.Integration.Common
 import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..))
-import Language.Marlowe.Runtime.Web (PayoutRef (..))
+import Language.Marlowe.Runtime.Web (PayoutHeader (..))
 import qualified Language.Marlowe.Runtime.Web as Web
 import Language.Marlowe.Runtime.Web.Client (Page (..), getPayouts, postWithdrawal, putWithdrawal)
 import Language.Marlowe.Runtime.Web.Common (signShelleyTransaction')
@@ -17,6 +17,7 @@ import Language.Marlowe.Runtime.Web.StandardContract (
   StandardContractNotified (..),
   createStandardContract,
  )
+import Language.Marlowe.Runtime.Web.Types (PayoutStatus (..))
 import Test.Hspec (Spec, describe, it)
 import Test.Integration.Marlowe.Local (withLocalMarloweRuntime)
 
@@ -30,7 +31,7 @@ spec = describe "PUT /contracts/{contractId}/withdrawals/{withdrawalId}" do
       let WalletAddresses{..} = addresses partyAWallet
       let webChangeAddress = toDTO changeAddress
       let webExtraAddresses = Set.map toDTO extraAddresses
-      let webCollataralUtxos = Set.map toDTO collateralUtxos
+      let webCollateralUtxos = Set.map toDTO collateralUtxos
       StandardContractInit{contractCreated, makeInitialDeposit} <- createStandardContract partyAWallet partyBWallet
       StandardContractFundsDeposited{chooseGimmeTheMoney} <- makeInitialDeposit
       StandardContractChoiceMade{sendNotify} <- chooseGimmeTheMoney
@@ -40,11 +41,11 @@ spec = describe "PUT /contracts/{contractId}/withdrawals/{withdrawalId}" do
       contractId <- case contractCreated of
         Web.CreateTxEnvelope{contractId} -> pure contractId
 
-      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing True Nothing
-      let payouts = Set.fromList $ payout <$> items
+      Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing (Just Available) Nothing
+      let payouts = Set.fromList $ payoutId <$> items
 
       Web.WithdrawTxEnvelope{withdrawalId, txEnvelope} <-
-        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollataralUtxos) Web.PostWithdrawalsRequest{..}
+        postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollateralUtxos) Web.PostWithdrawalsRequest{..}
       signedWithdrawalTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
       putWithdrawal withdrawalId signedWithdrawalTx
 
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index 489a4c4e3f..f043370ff2 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -78,7 +78,7 @@ import qualified Language.Marlowe.Core.V1.Semantics.Types as Sem
 import Language.Marlowe.Core.V1.Semantics.Types.Address (deserialiseAddressBech32, serialiseAddressBech32)
 import Language.Marlowe.Protocol.Query.Types (
   ContractState (..),
-  PayoutRef (..),
+  PayoutHeader (..),
   PayoutState (..),
   RuntimeStatus (..),
   SomeContractState (..),
@@ -312,14 +312,14 @@ instance ToDTO Chain.AssetId where
   toDTO Chain.AssetId{..} =
     Web.AssetId
       { policyId = toDTO policyId
-      , tokenName = toDTO tokenName
+      , assetName = toDTO tokenName
       }
 
 instance FromDTO Chain.AssetId where
   fromDTO Web.AssetId{..} =
     Chain.AssetId
       <$> fromDTO policyId
-      <*> fromDTO tokenName
+      <*> fromDTO assetName
 
 instance HasDTO Chain.TxId where
   type DTO Chain.TxId = Web.TxId
@@ -420,16 +420,17 @@ instance HasDTO Chain.BlockHeaderHash where
 instance ToDTO Chain.BlockHeaderHash where
   toDTO = coerce
 
-instance HasDTO PayoutRef where
-  type DTO PayoutRef = Web.PayoutRef
+instance HasDTO PayoutHeader where
+  type DTO PayoutHeader = Web.PayoutHeader
 
-instance ToDTO PayoutRef where
-  toDTO PayoutRef{..} =
-    Web.PayoutRef
+instance ToDTO PayoutHeader where
+  toDTO PayoutHeader{..} =
+    Web.PayoutHeader
       { contractId = toDTO contractId
-      , payout = toDTO payout
-      , roleTokenMintingPolicyId = toDTO rolesCurrency
+      , payoutId = toDTO payoutId
+      , withdrawalId = toDTO withdrawalId
       , role = toDTO role
+      , status = maybe Web.Available (const Web.Withdrawn) withdrawalId
       }
 
 instance HasDTO Withdrawal where
@@ -474,15 +475,15 @@ instance HasDTO SomePayoutState where
 
 instance ToDTO SomePayoutState where
   toDTO (SomePayoutState MarloweV1 PayoutState{..}) = case payout of
-    Payout address assets AssetId{..} ->
+    Payout address assets role ->
       Web.PayoutState
         { contractId = toDTO contractId
-        , payout = toDTO payoutId
-        , roleTokenMintingPolicyId = toDTO policyId
-        , role = toDTO tokenName
-        , address = toDTO address
-        , assets = toDTO assets
+        , payoutId = toDTO payoutId
         , withdrawalId = toDTO withdrawalId
+        , role = toDTO role
+        , payoutValidatorAddress = toDTO address
+        , assets = toDTO assets
+        , status = maybe Web.Available (const Web.Withdrawn) withdrawalId
         }
 
 instance HasDTO SomeTransaction where
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Payouts.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Payouts.hs
index 88ae6bea06..99f6ef8330 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Payouts.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Payouts.hs
@@ -5,6 +5,7 @@
 -- | This module defines a server for the /payouts REST API.
 module Language.Marlowe.Runtime.Web.Server.REST.Payouts where
 
+import Data.Functor ((<&>))
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
 import Language.Marlowe.Protocol.Query.Types (Page (..), PayoutFilter (..))
@@ -23,12 +24,12 @@ server =
 get
   :: [TxOutRef]
   -> [AssetId]
-  -> Bool
+  -> Maybe PayoutStatus
   -> Maybe (Ranges '["payoutId"] GetPayoutsResponse)
   -> ServerM (PaginatedResponse '["payoutId"] GetPayoutsResponse)
-get contractIds roleTokens unclaimed ranges = do
+get contractIds roleTokens status ranges = do
   let range :: Range "payoutId" TxOutRef
-      range = fromMaybe (getDefaultRange (Proxy @PayoutRef)) $ extractRange =<< ranges
+      range = fromMaybe (getDefaultRange (Proxy @PayoutHeader)) $ extractRange =<< ranges
   range' <- maybe (throwError $ rangeNotSatisfiable' "Invalid range value") pure $ fromPaginationRange range
   contractIds' <-
     traverse
@@ -39,7 +40,11 @@ get contractIds roleTokens unclaimed ranges = do
     traverse
       (\assetId -> maybe (throwError $ badRequest' $ "Invalid contractId value " <> show assetId) pure $ fromDTO assetId)
       roleTokens
-  let pFilter = PayoutFilter unclaimed (Set.fromList contractIds') (Set.fromList roleTokens')
+  let status' =
+        status <&> \case
+          Available -> False
+          Withdrawn -> True
+  let pFilter = PayoutFilter status' (Set.fromList contractIds') (Set.fromList roleTokens')
   loadPayouts pFilter range' >>= \case
     Nothing -> throwError $ rangeNotSatisfiable' "Initial payout ID not found"
     Just Page{..} -> do
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/SyncClient.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/SyncClient.hs
index f42ef3e766..e7939c2d2e 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/SyncClient.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/SyncClient.hs
@@ -26,7 +26,7 @@ import Language.Marlowe.Protocol.Query.Client (
 import Language.Marlowe.Protocol.Query.Types (
   ContractFilter,
   PayoutFilter (..),
-  PayoutRef,
+  PayoutHeader,
   SomeContractState,
   SomePayoutState,
   SomeTransaction (..),
@@ -74,7 +74,7 @@ type LoadWithdrawals m =
 type LoadPayouts m =
   PayoutFilter
   -> Query.Range TxOutRef
-  -> m (Maybe (Query.Page TxOutRef PayoutRef))
+  -> m (Maybe (Query.Page TxOutRef PayoutHeader))
   -- ^ Nothing if the initial ID is not found
 
 -- | Signature for a delegate that loads a single payout.
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
index f93b58712e..596527120b 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
@@ -356,16 +356,16 @@ instance HasNamedLink WithdrawalHeader API "withdrawal" where
 type GetPayoutsAPI =
   QueryParams "contractId" TxOutRef
     :> QueryParams "roleToken" AssetId
-    :> QueryFlag "unclaimed"
+    :> QueryParam "status" PayoutStatus
     :> PaginatedGet '["payoutId"] GetPayoutsResponse
 
-type GetPayoutsResponse = WithLink "payout" PayoutRef
+type GetPayoutsResponse = WithLink "payout" PayoutHeader
 
-instance HasNamedLink PayoutRef API "payout" where
+instance HasNamedLink PayoutHeader API "payout" where
   type
-    Endpoint PayoutRef API "payout" =
+    Endpoint PayoutHeader API "payout" =
       "payouts" :> Capture "payoutId" TxOutRef :> GetPayoutAPI
-  namedLink _ _ mkLink PayoutRef{..} = Just $ mkLink payout
+  namedLink _ _ mkLink PayoutHeader{..} = Just $ mkLink payoutId
 
 type GetPayoutAPI = Get '[JSON] GetPayoutResponse
 
@@ -385,7 +385,7 @@ instance HasNamedLink PayoutState API "transaction" where
         :> "transactions"
         :> Capture "transactionId" TxId
         :> GetTransactionAPI
-  namedLink _ _ mkLink PayoutState{..} = Just $ mkLink contractId $ txId payout
+  namedLink _ _ mkLink PayoutState{..} = Just $ mkLink contractId $ txId payoutId
 
 instance HasNamedLink PayoutState API "withdrawal" where
   type
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
index b788c1ac94..28ca25fd72 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
@@ -401,9 +401,9 @@ putWithdrawal = fmap void . putWithdrawalStatus
 getPayoutsStatus
   :: Maybe (Set TxOutRef)
   -> Maybe (Set AssetId)
-  -> Bool
+  -> Maybe PayoutStatus
   -> Maybe (Range "payoutId" TxOutRef)
-  -> ClientM (RuntimeStatus, Page "payoutId" PayoutRef)
+  -> ClientM (RuntimeStatus, Page "payoutId" PayoutHeader)
 getPayoutsStatus contractIds roleTokens unclaimed range = do
   let _ :<|> _ :<|> payoutsClient :<|> _ = client
   let getPayouts' :<|> _ = payoutsClient
@@ -426,9 +426,9 @@ getPayoutsStatus contractIds roleTokens unclaimed range = do
 getPayouts
   :: Maybe (Set TxOutRef)
   -> Maybe (Set AssetId)
-  -> Bool
+  -> Maybe PayoutStatus
   -> Maybe (Range "payoutId" TxOutRef)
-  -> ClientM (Page "payoutId" PayoutRef)
+  -> ClientM (Page "payoutId" PayoutHeader)
 getPayouts = (fmap . fmap . fmap . fmap) snd . getPayoutsStatus
 
 getPayoutStatus
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
index 082eced57a..0fa2f1771e 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
@@ -229,7 +229,7 @@ instance ToParamSchema PolicyId where
 
 data AssetId = AssetId
   { policyId :: PolicyId
-  , tokenName :: Text
+  , assetName :: Text
   }
   deriving (Show, Eq, Ord, Generic)
 
@@ -251,7 +251,7 @@ instance FromHttpApiData AssetId where
     _ -> Left "Expected ^[a-fA-F0-9]*\\..*$"
 
 instance ToHttpApiData AssetId where
-  toUrlPiece AssetId{..} = toUrlPiece policyId <> "." <> toUrlPiece tokenName
+  toUrlPiece AssetId{..} = toUrlPiece policyId <> "." <> toUrlPiece assetName
 
 newtype Party = Party {unParty :: T.Text}
   deriving (Eq, Ord, Generic)
@@ -344,6 +344,13 @@ instance ToSchema MarloweVersion where
           & OpenApi.description ?~ "A version of the Marlowe language."
           & enum_ ?~ ["v1"]
 
+data Payout = Payout
+  { payoutId :: TxOutRef
+  , role :: Text
+  , assets :: Assets
+  }
+  deriving (FromJSON, ToJSON, ToSchema, Show, Eq, Generic)
+
 data ContractState = ContractState
   { contractId :: TxOutRef
   , roleTokenMintingPolicyId :: PolicyId
@@ -363,24 +370,6 @@ data ContractState = ContractState
   }
   deriving (Show, Eq, Generic)
 
-data Payout = Payout
-  { payoutId :: TxOutRef
-  , role :: Text
-  , assets :: Assets
-  }
-  deriving (FromJSON, ToJSON, ToSchema, Show, Eq, Generic)
-
-data PayoutState = PayoutState
-  { contractId :: TxOutRef
-  , payout :: TxOutRef
-  , roleTokenMintingPolicyId :: PolicyId
-  , role :: Text
-  , address :: Address
-  , assets :: Assets
-  , withdrawalId :: Maybe TxId
-  }
-  deriving (FromJSON, ToJSON, ToSchema, Show, Eq, Generic)
-
 instance ToJSON ContractState
 instance FromJSON ContractState
 instance ToSchema ContractState
@@ -416,24 +405,75 @@ instance HasPagination WithdrawalHeader "withdrawalId" where
   type RangeType WithdrawalHeader "withdrawalId" = TxId
   getFieldValue _ WithdrawalHeader{..} = withdrawalId
 
-data PayoutRef = PayoutRef
-  { contractId :: TxOutRef
-  , payout :: TxOutRef
-  , roleTokenMintingPolicyId :: PolicyId
-  , role :: Text
+data PayoutStatus
+  = Available
+  | Withdrawn
+  deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON PayoutStatus where
+  toJSON =
+    String . \case
+      Available -> "available"
+      Withdrawn -> "withdrawn"
+
+instance FromJSON PayoutStatus where
+  parseJSON = withText "PayoutStatus" \str -> case T.toLower str of
+    "available" -> pure Available
+    "withdrawn" -> pure Withdrawn
+    _ -> fail "expected \"available\" or \"withdrawn\""
+
+instance ToHttpApiData PayoutStatus where
+  toQueryParam = \case
+    Available -> "available"
+    Withdrawn -> "withdrawn"
+
+instance FromHttpApiData PayoutStatus where
+  parseQueryParam str = case T.toLower str of
+    "available" -> pure Available
+    "withdrawn" -> pure Withdrawn
+    _ -> Left "expected \"available\" or \"withdrawn\""
+
+instance ToSchema PayoutStatus where
+  declareNamedSchema = pure . NamedSchema (Just "PayoutStatus") . toParamSchema
+
+instance ToParamSchema PayoutStatus where
+  toParamSchema _ =
+    mempty
+      & type_ ?~ OpenApiString
+      & enum_ ?~ ["available", "withdrawn"]
+      & OpenApi.description
+        ?~ "The status of a payout. Either it is available to be withdrawn, or it has already been withdrawn."
+
+data PayoutHeader = PayoutHeader
+  { payoutId :: TxOutRef
+  , contractId :: TxOutRef
+  , withdrawalId :: Maybe TxId
+  , role :: AssetId
+  , status :: PayoutStatus
   }
   deriving (Show, Eq, Ord, Generic)
 
-instance HasPagination PayoutRef "payoutId" where
-  type RangeType PayoutRef "payoutId" = TxOutRef
-  getFieldValue _ PayoutRef{..} = payout
+instance HasPagination PayoutHeader "payoutId" where
+  type RangeType PayoutHeader "payoutId" = TxOutRef
+  getFieldValue _ PayoutHeader{..} = payoutId
 
-instance ToJSON PayoutRef
-instance FromJSON PayoutRef
-instance ToSchema PayoutRef
+instance ToJSON PayoutHeader
+instance FromJSON PayoutHeader
+instance ToSchema PayoutHeader
+
+data PayoutState = PayoutState
+  { payoutId :: TxOutRef
+  , contractId :: TxOutRef
+  , withdrawalId :: Maybe TxId
+  , role :: AssetId
+  , payoutValidatorAddress :: Address
+  , status :: PayoutStatus
+  , assets :: Assets
+  }
+  deriving (FromJSON, ToJSON, ToSchema, Show, Eq, Generic)
 
 data Withdrawal = Withdrawal
-  { payouts :: Set PayoutRef
+  { payouts :: Set PayoutHeader
   , withdrawalId :: TxId
   , status :: TxStatus
   , block :: Maybe BlockHeader
@@ -525,11 +565,11 @@ instance FromJSON TxStatus where
 instance ToSchema TxStatus where
   declareNamedSchema _ =
     pure $
-      NamedSchema (Just "TxStatusHeader") $
+      NamedSchema (Just "TxStatus") $
         mempty
           & type_ ?~ OpenApiString
           & enum_ ?~ ["unsigned", "submitted", "confirmed"]
-          & OpenApi.description ?~ "A header of the status of a transaction on the local node."
+          & OpenApi.description ?~ "The status of a transaction on the local node."
 
 data BlockHeader = BlockHeader
   { slotNo :: Word64
diff --git a/marlowe-runtime-web/test/Spec.hs b/marlowe-runtime-web/test/Spec.hs
index 9a6b3f8fdd..af5bf29d48 100644
--- a/marlowe-runtime-web/test/Spec.hs
+++ b/marlowe-runtime-web/test/Spec.hs
@@ -142,13 +142,18 @@ instance Arbitrary Web.Payout where
       <*> arbitrary
   shrink = genericShrink
 
-instance Arbitrary Web.PayoutRef where
+instance Arbitrary Web.PayoutStatus where
+  arbitrary = elements [Web.Available, Web.Withdrawn]
+  shrink = genericShrink
+
+instance Arbitrary Web.PayoutHeader where
   arbitrary =
-    Web.PayoutRef
+    Web.PayoutHeader
       <$> arbitrary
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary Web.Assets where
@@ -287,6 +292,11 @@ instance Arbitrary Web.TextEnvelope where
 
 instance Arbitrary Web.TxOutRef where
   arbitrary = Web.TxOutRef <$> arbitrary <*> arbitrary
+  shrink = genericShrink
+
+instance Arbitrary Web.AssetId where
+  arbitrary = Web.AssetId <$> arbitrary <*> arbitrary
+  shrink = genericShrink
 
 instance Arbitrary Web.ContractSourceId where
   arbitrary = Web.ContractSourceId . BS.pack <$> replicateM 32 arbitrary
diff --git a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Client.hs b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Client.hs
index bdbac8b8f8..3b7ee403b9 100644
--- a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Client.hs
+++ b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Client.hs
@@ -39,7 +39,7 @@ getStatus :: (Applicative m) => MarloweQueryClient m RuntimeStatus
 getStatus = request ReqStatus
 
 getPayouts
-  :: (Applicative m) => PayoutFilter -> Range TxOutRef -> MarloweQueryClient m (Maybe (Page TxOutRef PayoutRef))
+  :: (Applicative m) => PayoutFilter -> Range TxOutRef -> MarloweQueryClient m (Maybe (Page TxOutRef PayoutHeader))
 getPayouts = fmap request . ReqPayouts
 
 getPayout :: (Applicative m) => TxOutRef -> MarloweQueryClient m (Maybe SomePayoutState)
diff --git a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Server.hs b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Server.hs
index 690da6406d..6c012b3328 100644
--- a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Server.hs
+++ b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Server.hs
@@ -41,7 +41,7 @@ marloweQueryServer
   -> (ContractId -> m (Maybe SomeTransactions))
   -> (TxId -> m (Maybe Withdrawal))
   -> (WithdrawalFilter -> Range TxId -> m (Maybe (Page TxId Withdrawal)))
-  -> (PayoutFilter -> Range TxOutRef -> m (Maybe (Page TxOutRef PayoutRef)))
+  -> (PayoutFilter -> Range TxOutRef -> m (Maybe (Page TxOutRef PayoutHeader)))
   -> (TxOutRef -> m (Maybe SomePayoutState))
   -> MarloweQueryServer m ()
 marloweQueryServer
diff --git a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Types.hs b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Types.hs
index 64b58dc532..857310f1bb 100644
--- a/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Types.hs
+++ b/marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Types.hs
@@ -13,13 +13,14 @@ import Data.Binary (Binary (..), getWord8, putWord8)
 import Data.Function (on)
 import qualified Data.List.NonEmpty as NE
 import Data.Map (Map)
+import Data.Monoid (Any (..))
 import Data.Set (Set)
 import Data.Time (UTCTime)
 import Data.Type.Equality (testEquality, type (:~:) (Refl))
 import Data.Version (Version)
 import GHC.Generics (Generic)
 import GHC.Show (showSpace)
-import Language.Marlowe.Runtime.ChainSync.Api (AssetId, BlockHeader, ChainPoint, PolicyId, TokenName, TxId, TxOutRef)
+import Language.Marlowe.Runtime.ChainSync.Api (AssetId, BlockHeader, ChainPoint, PolicyId, TxId, TxOutRef)
 import Language.Marlowe.Runtime.Core.Api (
   ContractId,
   MarloweMetadataTag,
@@ -71,7 +72,7 @@ instance Monoid ContractFilter where
       }
 
 data PayoutFilter = PayoutFilter
-  { unclaimed :: Bool
+  { isWithdrawn :: Maybe Bool
   , contractIds :: Set ContractId
   , roleTokens :: Set AssetId
   }
@@ -81,7 +82,7 @@ data PayoutFilter = PayoutFilter
 instance Semigroup PayoutFilter where
   a <> b =
     PayoutFilter
-      { unclaimed = on (||) unclaimed a b
+      { isWithdrawn = getAny <$> on (<>) (fmap Any . isWithdrawn) a b
       , contractIds = on (<>) contractIds a b
       , roleTokens = on (<>) roleTokens a b
       }
@@ -89,7 +90,7 @@ instance Semigroup PayoutFilter where
 instance Monoid PayoutFilter where
   mempty =
     PayoutFilter
-      { unclaimed = False
+      { isWithdrawn = Nothing
       , contractIds = mempty
       , roleTokens = mempty
       }
@@ -115,7 +116,7 @@ data MarloweSyncRequest a where
   ReqTransactions :: ContractId -> MarloweSyncRequest (Maybe SomeTransactions)
   ReqWithdrawal :: TxId -> MarloweSyncRequest (Maybe Withdrawal)
   ReqWithdrawals :: WithdrawalFilter -> Range TxId -> MarloweSyncRequest (Maybe (Page TxId Withdrawal))
-  ReqPayouts :: PayoutFilter -> Range TxOutRef -> MarloweSyncRequest (Maybe (Page TxOutRef PayoutRef))
+  ReqPayouts :: PayoutFilter -> Range TxOutRef -> MarloweSyncRequest (Maybe (Page TxOutRef PayoutHeader))
   ReqPayout :: TxOutRef -> MarloweSyncRequest (Maybe SomePayoutState)
 
 deriving instance Show (MarloweSyncRequest a)
@@ -130,7 +131,7 @@ instance Request MarloweSyncRequest where
     TagTransactions :: Tag MarloweSyncRequest (Maybe SomeTransactions)
     TagWithdrawal :: Tag MarloweSyncRequest (Maybe Withdrawal)
     TagWithdrawals :: Tag MarloweSyncRequest (Maybe (Page TxId Withdrawal))
-    TagPayouts :: Tag MarloweSyncRequest (Maybe (Page TxOutRef PayoutRef))
+    TagPayouts :: Tag MarloweSyncRequest (Maybe (Page TxOutRef PayoutHeader))
     TagPayout :: Tag MarloweSyncRequest (Maybe SomePayoutState)
   tagFromReq = \case
     ReqStatus -> TagStatus
@@ -523,11 +524,11 @@ deriving instance ToJSON (ContractState 'V1)
 deriving instance Variations (ContractState 'V1)
 deriving instance Binary (ContractState 'V1)
 
-data PayoutRef = PayoutRef
+data PayoutHeader = PayoutHeader
   { contractId :: ContractId
-  , payout :: TxOutRef
-  , rolesCurrency :: PolicyId
-  , role :: TokenName
+  , payoutId :: TxOutRef
+  , withdrawalId :: Maybe TxId
+  , role :: AssetId
   }
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (ToJSON, Binary, Variations)
@@ -535,8 +536,8 @@ data PayoutRef = PayoutRef
 data PayoutState v = PayoutState
   { contractId :: ContractId
   , payoutId :: TxOutRef
-  , payout :: Payout v
   , withdrawalId :: Maybe TxId
+  , payout :: Payout v
   }
   deriving (Generic)
 
@@ -548,7 +549,7 @@ deriving instance Binary (PayoutState 'V1)
 
 data Withdrawal = Withdrawal
   { block :: BlockHeader
-  , withdrawnPayouts :: Map TxOutRef PayoutRef
+  , withdrawnPayouts :: Map TxOutRef PayoutHeader
   , withdrawalTx :: TxId
   }
   deriving stock (Eq, Ord, Show, Generic)
diff --git a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database.hs b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database.hs
index 8438ac9c65..1955b49e6b 100644
--- a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database.hs
+++ b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database.hs
@@ -15,7 +15,7 @@ import Language.Marlowe.Protocol.Query.Types (
   ContractFilter,
   Page,
   PayoutFilter,
-  PayoutRef,
+  PayoutHeader,
   Range,
   SomeContractState,
   SomePayoutState,
@@ -45,7 +45,7 @@ data DatabaseSelector f where
   GetTransactions :: DatabaseSelector (QueryField ContractId (Maybe SomeTransactions))
   GetWithdrawal :: DatabaseSelector (QueryField TxId (Maybe Withdrawal))
   GetWithdrawals :: DatabaseSelector (QueryField GetWithdrawalsArguments (Maybe (Page TxId Withdrawal)))
-  GetPayouts :: DatabaseSelector (QueryField GetPayoutsArguments (Maybe (Page TxOutRef PayoutRef)))
+  GetPayouts :: DatabaseSelector (QueryField GetPayoutsArguments (Maybe (Page TxOutRef PayoutHeader)))
   GetPayout :: DatabaseSelector (QueryField TxOutRef (Maybe SomePayoutState))
 
 data GetPayoutsArguments = GetPayoutsArguments
@@ -216,7 +216,7 @@ data DatabaseQueries m = DatabaseQueries
   , getTransactions :: ContractId -> m (Maybe SomeTransactions)
   , getWithdrawal :: TxId -> m (Maybe Withdrawal)
   , getWithdrawals :: WithdrawalFilter -> Range TxId -> m (Maybe (Page TxId Withdrawal))
-  , getPayouts :: PayoutFilter -> Range TxOutRef -> m (Maybe (Page TxOutRef PayoutRef))
+  , getPayouts :: PayoutFilter -> Range TxOutRef -> m (Maybe (Page TxOutRef PayoutHeader))
   , getPayout :: TxOutRef -> m (Maybe SomePayoutState)
   }
 
diff --git a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetPayouts.hs b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetPayouts.hs
index 51c5e2cd8a..915104f04c 100644
--- a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetPayouts.hs
+++ b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetPayouts.hs
@@ -15,14 +15,13 @@ import Language.Marlowe.Protocol.Query.Types (
   Order (..),
   Page (..),
   PayoutFilter (..),
-  PayoutRef (..),
+  PayoutHeader (..),
   Range (..),
  )
 import Language.Marlowe.Runtime.ChainSync.Api (
-  AssetId (..),
   TxOutRef (..),
  )
-import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetWithdrawal (decodePayoutRef)
+import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetWithdrawal (decodePayoutHeader)
 import Prelude hiding (init)
 
 -- | Fetch a page of payouts for a given filter and range.
@@ -31,17 +30,36 @@ getPayouts
   -- ^ The filter, which controls which payouts are included in the result set.
   -> Range TxOutRef
   -- ^ The page range, which controls which results from the result set are returned, and in what order.
-  -> T.Transaction (Maybe (Page TxOutRef PayoutRef))
+  -> T.Transaction (Maybe (Page TxOutRef PayoutHeader))
 getPayouts PayoutFilter{..} Range{..} = do
   -- FIXME this is a temporary, limited and memory-intensive implementation that needs to be replaced with dynamic SQL.
   allPayouts <-
-    V.toList . fmap (uncurry6 decodePayoutRef)
+    V.toList . fmap (uncurry7 decodePayoutHeader)
       <$> T.statement
         ()
-        if unclaimed
-          then
+        case isWithdrawn of
+          Just True ->
             [vectorStatement|
               SELECT
+                withdrawalTxIn.txId :: bytea?,
+                applyTx.createTxId :: bytea,
+                applyTx.createTxIx :: smallint,
+                payoutTxOut.txId :: bytea,
+                payoutTxOut.txIx :: smallint,
+                payoutTxOut.rolesCurrency :: bytea,
+                payoutTxOut.role :: bytea
+              FROM marlowe.payoutTxOut
+              NATURAL JOIN marlowe.applyTx
+              LEFT JOIN marlowe.withdrawalTxIn
+                ON payoutTxOut.txId = withdrawalTxIn.payoutTxId
+                AND payoutTxOut.txIx = withdrawalTxIn.payoutTxIx
+              WHERE withdrawalTxIn.txId IS NOT NULL
+              ORDER BY applyTx.slotNo, payoutTxOut.txId, payoutTxOut.txIx
+            |]
+          Just False ->
+            [vectorStatement|
+              SELECT
+                withdrawalTxIn.txId :: bytea?,
                 applyTx.createTxId :: bytea,
                 applyTx.createTxIx :: smallint,
                 payoutTxOut.txId :: bytea,
@@ -56,9 +74,10 @@ getPayouts PayoutFilter{..} Range{..} = do
               WHERE withdrawalTxIn.txId IS NULL
               ORDER BY applyTx.slotNo, payoutTxOut.txId, payoutTxOut.txIx
             |]
-          else
+          Nothing ->
             [vectorStatement|
               SELECT
+                withdrawalTxIn.txId :: bytea?,
                 applyTx.createTxId :: bytea,
                 applyTx.createTxIx :: smallint,
                 payoutTxOut.txId :: bytea,
@@ -67,6 +86,9 @@ getPayouts PayoutFilter{..} Range{..} = do
                 payoutTxOut.role :: bytea
               FROM marlowe.payoutTxOut
               NATURAL JOIN marlowe.applyTx
+              LEFT JOIN marlowe.withdrawalTxIn
+                ON payoutTxOut.txId = withdrawalTxIn.payoutTxId
+                AND payoutTxOut.txIx = withdrawalTxIn.payoutTxIx
               ORDER BY applyTx.slotNo, payoutTxOut.txId, payoutTxOut.txIx
             |]
   pure do
@@ -75,27 +97,24 @@ getPayouts PayoutFilter{..} Range{..} = do
           | otherwise = filter (flip Set.member contractIds . contractId) allPayouts
     let filtered
           | Set.null roleTokens = contractIdsFiltered
-          | otherwise = filter (flip Set.member roleTokens . payoutRefRoleToken) contractIdsFiltered
+          | otherwise = filter (flip Set.member roleTokens . role) contractIdsFiltered
     let ordered = case rangeDirection of
           Ascending -> filtered
           Descending -> reverse filtered
     delimited <- case rangeStart of
       Nothing -> pure ordered
       Just startFrom -> do
-        guard $ any ((== startFrom) . payout) ordered
-        pure $ dropWhile ((/= startFrom) . payout) ordered
+        guard $ any ((== startFrom) . payoutId) ordered
+        pure $ dropWhile ((/= startFrom) . payoutId) ordered
     let items = take rangeLimit . drop rangeOffset $ delimited
     pure
       Page
         { items
         , nextRange = do
-            PayoutRef{..} <- listToMaybe $ reverse items
-            pure $ Range{rangeStart = Just payout, rangeOffset = 1, ..}
+            PayoutHeader{..} <- listToMaybe $ reverse items
+            pure $ Range{rangeStart = Just payoutId, rangeOffset = 1, ..}
         , totalCount = length filtered
         }
 
-payoutRefRoleToken :: PayoutRef -> AssetId
-payoutRefRoleToken PayoutRef{..} = AssetId rolesCurrency role
-
-uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
-uncurry6 g (a, b, c, d, e, f) = g a b c d e f
+uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a, b, c, d, e, f, g) -> h
+uncurry7 f' (a, b, c, d, e, f, g) = f' a b c d e f g
diff --git a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetWithdrawal.hs b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetWithdrawal.hs
index 48f8d1efd0..91b7eb751d 100644
--- a/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetWithdrawal.hs
+++ b/marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetWithdrawal.hs
@@ -12,7 +12,7 @@ import qualified Data.Vector as V
 import Hasql.TH (maybeStatement)
 import qualified Hasql.Transaction as T
 import Language.Marlowe.Protocol.Query.Types
-import Language.Marlowe.Runtime.ChainSync.Api (PolicyId (..), TokenName (..), TxId (..))
+import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..), PolicyId (..), TokenName (..), TxId (..))
 import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetContractState (
   decodeBlockHeader,
   decodeContractId,
@@ -65,15 +65,16 @@ decodeWithdrawal (txId, slot, hash, block, payoutTxIds, payoutTxIxs, createTxIds
         Map.fromList $
           V.toList $
             V.zip (V.zipWith decodeTxOutRef payoutTxIds payoutTxIxs) $
-              V.zipWith6 decodePayoutRef createTxIds createTxIxs payoutTxIds payoutTxIxs roleCurrencies roles
+              V.zipWith6 (decodePayoutHeader $ Just txId) createTxIds createTxIxs payoutTxIds payoutTxIxs roleCurrencies roles
     , withdrawalTx = TxId txId
     }
 
-decodePayoutRef :: ByteString -> Int16 -> ByteString -> Int16 -> ByteString -> ByteString -> PayoutRef
-decodePayoutRef createTxId createTxIx txId txIx rolesCurrency role =
-  PayoutRef
-    { contractId = decodeContractId createTxId createTxIx
-    , payout = decodeTxOutRef txId txIx
-    , rolesCurrency = PolicyId rolesCurrency
-    , role = TokenName role
+decodePayoutHeader
+  :: Maybe ByteString -> ByteString -> Int16 -> ByteString -> Int16 -> ByteString -> ByteString -> PayoutHeader
+decodePayoutHeader withdrawalId contractTxId contractTxIx txId txIx rolesCurrency role =
+  PayoutHeader
+    { contractId = decodeContractId contractTxId contractTxIx
+    , payoutId = decodeTxOutRef txId txIx
+    , withdrawalId = TxId <$> withdrawalId
+    , role = AssetId (PolicyId rolesCurrency) $ TokenName role
     }
diff --git a/marlowe-runtime/test/Language/Marlowe/Protocol/QuerySpec.hs b/marlowe-runtime/test/Language/Marlowe/Protocol/QuerySpec.hs
index fc0062d7e6..e1b1a0acfc 100644
--- a/marlowe-runtime/test/Language/Marlowe/Protocol/QuerySpec.hs
+++ b/marlowe-runtime/test/Language/Marlowe/Protocol/QuerySpec.hs
@@ -158,8 +158,8 @@ instance (Arbitrary a) => Arbitrary (Range a) where
   arbitrary = Range <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
   shrink = genericShrink
 
-instance Arbitrary PayoutRef where
-  arbitrary = PayoutRef <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+instance Arbitrary PayoutHeader where
+  arbitrary = PayoutHeader <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary Withdrawal where

From cc37e7c2fef6ebc4ddf1c0991fd7e9367d98d2d7 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Wed, 23 Aug 2023 13:11:23 -0600
Subject: [PATCH 08/10] Update withdrawal tests to test new API better

---
 .../Marlowe/Runtime/Integration/Withdraw.hs   | 222 ++++++++++++++----
 1 file changed, 181 insertions(+), 41 deletions(-)

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
index 2aea8dad2b..68e5f2ac9d 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
@@ -1,71 +1,211 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 
 module Language.Marlowe.Runtime.Integration.Withdraw where
 
+import Cardano.Api (BabbageEra, getTxId)
 import Cardano.Api.Shelley (
   ReferenceTxInsScriptsInlineDatumsSupportedInEra (ReferenceTxInsScriptsInlineDatumsInBabbageEra),
  )
+import Control.Arrow ((&&&))
 import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ask)
 import Control.Monad.Trans.Marlowe.Class (withdraw)
 import qualified Data.Map as Map
-import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..), Assets (Assets))
-import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..), Payout (Payout), TransactionOutput (..))
-import Language.Marlowe.Runtime.Integration.Common (Wallet (..), expectRight, getGenesisWallet, runIntegrationTest)
+import qualified Data.Set as Set
+import Language.Marlowe.Protocol.Query.Types (PayoutState (..))
+import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
+import Language.Marlowe.Runtime.ChainSync.Api (TxOutRef (..))
+import Language.Marlowe.Runtime.Core.Api (
+  ContractId (unContractId),
+  MarloweVersion (..),
+  MarloweVersionTag (..),
+  Payout (..),
+  TransactionOutput (..),
+  toChainDatum,
+ )
+import Language.Marlowe.Runtime.Integration.Common (
+  Integration,
+  Wallet (..),
+  expectRight,
+  getGenesisWallet,
+  runIntegrationTest,
+ )
 import Language.Marlowe.Runtime.Integration.StandardContract
 import Language.Marlowe.Runtime.Transaction.Api (
-  ConstraintError (RoleTokenNotFound),
+  ConstraintError (..),
   ContractCreatedInEra (..),
   InputsAppliedInEra (..),
+  WalletAddresses (..),
   WithdrawError (..),
-  WithdrawTx (..),
+  WithdrawTx (WithdrawTx),
   WithdrawTxInEra (..),
  )
 import Test.Hspec
-import Test.Integration.Marlowe.Local (withLocalMarloweRuntime)
+import Test.Integration.Marlowe.Local (MarloweRuntime, withLocalMarloweRuntime)
 
 spec :: Spec
-spec = describe "Withdraw" do
-  it "Withdraw missing role token" missingRoleTokenTest
-  it "Withdraw no payouts" noPayoutsTest
-  it "Withdraws funds" payoutsTest
-
-missingRoleTokenTest :: IO ()
-missingRoleTokenTest = withLocalMarloweRuntime $ runIntegrationTest do
-  wallet1 <- getGenesisWallet 0
-  wallet2 <- getGenesisWallet 1
-  step1 <- createStandardContract wallet1 wallet2
-  step2 <- makeInitialDeposit step1
-  step3 <- chooseGimmeTheMoney step2
-  step4 <- sendNotify step3
-  StandardContractClosed{returnDeposited = InputsAppliedInEra{output}} <- makeReturnDeposit step4
-  let TransactionOutput{payouts} = output
-  result <- withdraw MarloweV1 (addresses wallet2) $ Map.keysSet payouts
-  let policyId = case contractCreated step1 of ContractCreatedInEra{..} -> rolesCurrency
-  liftIO $ result `shouldBe` Left (WithdrawConstraintError $ RoleTokenNotFound $ AssetId policyId "Party A")
+spec = focus $ describe "Withdraw" $ aroundAll setup do
+  it "Fails on empty payouts" noPayoutsTest
+  it "Fails on non-payout script outputs" nonPayoutTest
+  it "Fails on non-script outputs" nonScriptPayoutTest
+  it "Fails on made-up payouts" nonExistentPayoutTest
+  it "Fails on withdrawn payouts" withdrawnPayoutTest
+  it "Fails when the wallet doesn't have the necessary role token" missingRoleTokenTest
+  it "Withdraws 1 payout from 1 contract" singlePayoutTest
+  it "Withdraws 2 payouts from 2 contracts" multiPayoutTest
+  it "Withdraws 3 payouts from 3 contracts for 2 wallets" multiPayoutMultiWalletTest
 
-noPayoutsTest :: IO ()
-noPayoutsTest = withLocalMarloweRuntime $ runIntegrationTest do
-  wallet1 <- getGenesisWallet 0
-  wallet2 <- getGenesisWallet 1
-  step1 <- createStandardContract wallet1 wallet2
-  step2 <- makeInitialDeposit step1
-  step3 <- chooseGimmeTheMoney step2
-  _ <- sendNotify step3
+noPayoutsTest :: ActionWith TestData
+noPayoutsTest TestData{..} = flip runIntegrationTest runtime do
   result <- withdraw MarloweV1 (addresses wallet1) mempty
   liftIO $ result `shouldBe` Left EmptyPayouts
 
-payoutsTest :: IO ()
-payoutsTest = withLocalMarloweRuntime $ runIntegrationTest do
+nonPayoutTest :: ActionWith TestData
+nonPayoutTest TestData{..} = flip runIntegrationTest runtime do
+  let ContractCreatedInEra{..} = randomCreation
+  let fakePayout = unContractId contractId
+  let realPayout = payoutId wallet1AvailablePayout1
+  result <- withdraw MarloweV1 (addresses wallet1) $ Set.fromList [fakePayout, realPayout]
+  liftIO $
+    result `shouldBe` Left (WithdrawConstraintError $ InvalidPayoutDatum fakePayout $ Just $ toChainDatum MarloweV1 datum)
+
+nonScriptPayoutTest :: ActionWith TestData
+nonScriptPayoutTest TestData{..} = flip runIntegrationTest runtime do
+  let ContractCreatedInEra{..} = randomCreation
+  let fakePayout = (unContractId contractId){txIx = 0}
+  let realPayout = payoutId wallet1AvailablePayout1
+  result <- withdraw MarloweV1 (addresses wallet1) $ Set.fromList [fakePayout, realPayout]
+  liftIO $
+    result `shouldBe` Left (WithdrawConstraintError $ InvalidPayoutDatum fakePayout Nothing)
+
+nonExistentPayoutTest :: ActionWith TestData
+nonExistentPayoutTest TestData{..} = flip runIntegrationTest runtime do
+  let fakePayout = TxOutRef "0000000000000000000000000000000000000000000000000000000000000000" 0
+  let realPayout = payoutId wallet1AvailablePayout1
+  result <- withdraw MarloweV1 (addresses wallet1) $ Set.fromList [fakePayout, realPayout]
+  liftIO $ result `shouldBe` Left (WithdrawConstraintError $ PayoutNotFound fakePayout)
+
+withdrawnPayoutTest :: ActionWith TestData
+withdrawnPayoutTest TestData{..} = flip runIntegrationTest runtime do
+  result <-
+    withdraw MarloweV1 (addresses wallet1) $
+      Set.fromList $
+        payoutId <$> [wallet1AvailablePayout1, wallet1AvailablePayout2, wallet1WithdrawnPayout]
+  liftIO $ result `shouldBe` Left (WithdrawConstraintError $ PayoutNotFound $ payoutId wallet1WithdrawnPayout)
+
+missingRoleTokenTest :: ActionWith TestData
+missingRoleTokenTest TestData{..} = flip runIntegrationTest runtime do
+  result <-
+    withdraw MarloweV1 (addresses wallet1) $
+      Set.fromList $
+        payoutId <$> [wallet1AvailablePayout1, wallet1AvailablePayout2, wallet2AvailablePayout]
+  liftIO $
+    result
+      `shouldBe` Left (WithdrawConstraintError $ RoleTokenNotFound case payout wallet2AvailablePayout of Payout{..} -> datum)
+
+singlePayoutTest :: ActionWith TestData
+singlePayoutTest TestData{..} = flip runIntegrationTest runtime do
+  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{..} <-
+    expectRight "expected withdraw to succeed"
+      =<< withdraw MarloweV1 (addresses wallet1) (Set.singleton $ payoutId wallet1AvailablePayout1)
+  let expectedInputs = Map.singleton (payoutId wallet1AvailablePayout1) (payout wallet1AvailablePayout1)
+  liftIO $ inputs `shouldBe` expectedInputs
+
+multiPayoutTest :: ActionWith TestData
+multiPayoutTest TestData{..} = flip runIntegrationTest runtime do
+  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{..} <-
+    expectRight "expected withdraw to succeed"
+      =<< withdraw
+        MarloweV1
+        (addresses wallet1)
+        (Set.fromList $ payoutId <$> [wallet1AvailablePayout1, wallet1AvailablePayout2])
+  let expectedInputs = Map.fromList $ (payoutId &&& payout) <$> [wallet1AvailablePayout1, wallet1AvailablePayout2]
+  liftIO $ inputs `shouldBe` expectedInputs
+
+multiPayoutMultiWalletTest :: ActionWith TestData
+multiPayoutMultiWalletTest TestData{..} = flip runIntegrationTest runtime do
+  let wallet1Addresses = addresses wallet1
+  let wallet2Addresses = addresses wallet2
+  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{..} <-
+    expectRight "expected withdraw to succeed"
+      =<< withdraw
+        MarloweV1
+        wallet1Addresses
+          { extraAddresses =
+              Set.insert
+                (changeAddress wallet2Addresses)
+                (extraAddresses wallet1Addresses <> extraAddresses wallet2Addresses)
+          }
+        (Set.fromList $ payoutId <$> [wallet1AvailablePayout1, wallet1AvailablePayout2, wallet2AvailablePayout])
+  let expectedInputs =
+        Map.fromList $
+          (payoutId &&& payout) <$> [wallet1AvailablePayout1, wallet1AvailablePayout2, wallet2AvailablePayout]
+  liftIO $ inputs `shouldBe` expectedInputs
+
+data TestData = TestData
+  { wallet1AvailablePayout1 :: PayoutState 'V1
+  , wallet1AvailablePayout2 :: PayoutState 'V1
+  , wallet1WithdrawnPayout :: PayoutState 'V1
+  , wallet2AvailablePayout :: PayoutState 'V1
+  , randomCreation :: ContractCreatedInEra BabbageEra 'V1
+  , wallet1 :: Wallet
+  , wallet2 :: Wallet
+  , runtime :: MarloweRuntime
+  }
+
+setup :: ActionWith TestData -> IO ()
+setup runTests = withLocalMarloweRuntime $ runIntegrationTest do
+  runtime <- ask
   wallet1 <- getGenesisWallet 0
-  wallet2 <- getGenesisWallet 1
-  StandardContractInit{..} <- createStandardContract wallet1 wallet2
+  wallet2 <- getGenesisWallet 2
+  (wallet1AvailablePayout1, wallet1AvailablePayout2, wallet1WithdrawnPayout) <- setupPayments wallet1 wallet2
+  wallet2AvailablePayout <- createAndExecuteStandardContractWithoutWithdrawing wallet2 wallet1
+  StandardContractInit{contractCreated = randomCreation} <- createStandardContract wallet1 wallet2
+  liftIO $ runTests TestData{..}
+
+setupPayments :: Wallet -> Wallet -> Integration (PayoutState 'V1, PayoutState 'V1, PayoutState 'V1)
+setupPayments partyA partyB = do
+  (,,)
+    <$> createAndExecuteStandardContractWithoutWithdrawing partyA partyB
+    <*> createAndExecuteStandardContractWithoutWithdrawing partyA partyB
+    <*> createAndExecuteStandardContract partyA partyB
+
+createAndExecuteStandardContractWithoutWithdrawing :: Wallet -> Wallet -> Integration (PayoutState 'V1)
+createAndExecuteStandardContractWithoutWithdrawing partyA partyB = do
+  StandardContractInit{..} <- createStandardContract partyA partyB
   let ContractCreatedInEra{..} = contractCreated
   step2 <- makeInitialDeposit
   step3 <- chooseGimmeTheMoney step2
   step4 <- sendNotify step3
   StandardContractClosed{returnDeposited = InputsAppliedInEra{output}} <- makeReturnDeposit step4
-  let TransactionOutput{payouts} = output
-  WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{inputs} <-
-    expectRight "failed to withdraw payouts" =<< withdraw MarloweV1 (addresses wallet1) (Map.keysSet payouts)
-  liftIO $
-    Map.elems inputs `shouldBe` [Payout payoutScriptAddress (Assets 100_000_000 mempty) $ AssetId rolesCurrency "Party A"]
+  case Map.toList $ payouts output of
+    [(payoutId, payout)] ->
+      pure
+        PayoutState
+          { contractId
+          , payoutId
+          , withdrawalId = Nothing
+          , payout
+          }
+    _ -> fail $ "Expected 1 payout, got: " <> show (payouts output)
+
+createAndExecuteStandardContract :: Wallet -> Wallet -> Integration (PayoutState 'V1)
+createAndExecuteStandardContract partyA partyB = do
+  StandardContractInit{..} <- createStandardContract partyA partyB
+  let ContractCreatedInEra{contractId} = contractCreated
+  step2 <- makeInitialDeposit
+  step3 <- chooseGimmeTheMoney step2
+  step4 <- sendNotify step3
+  step5 <- makeReturnDeposit step4
+  (WithdrawTxInEra{inputs, txBody}, _) <- withdrawPartyAFunds step5
+  case Map.toList inputs of
+    [(payoutId, payout)] ->
+      pure
+        PayoutState
+          { contractId
+          , payoutId
+          , withdrawalId = Just $ fromCardanoTxId $ getTxId txBody
+          , payout
+          }
+    _ -> fail $ "Expected 1 payout, got: " <> show inputs

From 16de075cbbf26c47fa5d99c43cd8a31e54df81ad Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Mon, 28 Aug 2023 08:09:43 -0600
Subject: [PATCH 09/10] Update golden tests

---
 marlowe-runtime/.golden/MarloweQuery/golden | 148 +++++++++++---------
 1 file changed, 81 insertions(+), 67 deletions(-)

diff --git a/marlowe-runtime/.golden/MarloweQuery/golden b/marlowe-runtime/.golden/MarloweQuery/golden
index 9041c59127..74a051e954 100644
--- a/marlowe-runtime/.golden/MarloweQuery/golden
+++ b/marlowe-runtime/.golden/MarloweQuery/golden
@@ -74,26 +74,28 @@ Show: MsgRequest (ReqLeaf (ReqWithdrawals (WithdrawalFilter {roleCurrencies = fr
 Binary: 01000600000000000000010000000000000000000000000000000001000000000000000100
 Show: MsgRequest (ReqLeaf (ReqWithdrawals (WithdrawalFilter {roleCurrencies = fromList ["61"]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 0100060000000000000001000000000000000161000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 0100080000000000000000000000000000000000000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Descending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Descending})))
 Binary: 0100080000000000000000000000000000000000000000000000000001000000000000000101
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Just (TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}), rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Just (TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}), rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 010008000000000000000000000000000000000001000000000000000000010000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Just (TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}), rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Just (TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}), rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 01000800000000000000000000000000000000000100000000000000016100010000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "", tokenName = ""}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "", tokenName = ""}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 010008000000000000000000000000000000000100000000000000000000000000000000000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "", tokenName = "a"}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "", tokenName = "a"}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 01000800000000000000000000000000000000010000000000000000000000000000000161000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "61", tokenName = ""}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [], roleTokens = fromList [AssetId {policyId = "61", tokenName = ""}]}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 01000800000000000000000000000000000000010000000000000001610000000000000000000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 010008000000000000000001000000000000000000010000000000000000000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = False, contractIds = fromList [ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Nothing, contractIds = fromList [ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
 Binary: 01000800000000000000000100000000000000016100010000000000000000000000000000000001000000000000000100
-Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {unclaimed = True, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
-Binary: 0100080100000000000000000000000000000000000000000000000001000000000000000100
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Just False, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Binary: 010008010000000000000000000000000000000000000000000000000001000000000000000100
+Show: MsgRequest (ReqLeaf (ReqPayouts (PayoutFilter {isWithdrawn = Just True, contractIds = fromList [], roleTokens = fromList []}) (Range {rangeStart = Nothing, rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending})))
+Binary: 010008010100000000000000000000000000000000000000000000000001000000000000000100
 Show: MsgRequest (ReqLeaf (ReqPayout (TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}})))
 Binary: 01000900000000000000000001
 Show: MsgRequest (ReqLeaf (ReqPayout (TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}})))
@@ -5164,18 +5166,22 @@ Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlot
 Binary: 0100000000000000010000000000000000000000000000000100000000000000000000000000000000
 Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [], withdrawalTx = "61"}))
 Binary: 010000000000000001000000000000000000000000000000010000000000000000000000000000000161
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}))
-Binary: 010000000000000001000000000000000000000000000000010000000000000001000000000000000000010000000000000000000100000000000000000001000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = "a"})], withdrawalTx = ""}))
-Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000000000000000000001610000000000000000
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "61", role = ""})], withdrawalTx = ""}))
-Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000016100000000000000000000000000000000
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}))
-Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000001610001000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}))
-Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000161000100000000000000000001000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}))
-Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000016100010000000000000000000100000000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = "a"}})], withdrawalTx = ""}))
+Binary: 0100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000000010000000000000000000000000000000001610000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "61", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 0100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000000010000000000000000016100000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "", role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 010000000000000001000000000000000000000000000000010000000000000001000000000000000000010000000000000000000100000000000000000001010000000000000000000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "61", role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 01000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000101000000000000000161000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 0100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000161000100000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 0100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000016100010000000000000000000100000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}))
+Binary: 0100000000000000010000000000000000000000000000000100000000000000010000000000000001610001000000000000000000010000000000000000000100000000000000000000000000000000000000000000000000
 Show: MsgRespond (Just (Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [], withdrawalTx = ""}))
 Binary: 010000000000000001000000000000000161000000000000000100000000000000000000000000000000
 Show: MsgRespond Nothing
@@ -5194,18 +5200,22 @@ Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo =
 Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000000000000000000000000000000000000001
 Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [], withdrawalTx = "61"}], nextRange = Nothing, totalCount = 1}))
 Binary: 0100000000000000010000000000000001000000000000000000000000000000010000000000000000000000000000000161000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 0100000000000000010000000000000001000000000000000000000000000000010000000000000001000000000000000000010000000000000000000100000000000000000001000000000000000000000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = "a"})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000000000000000000001610000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "61", role = ""})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000016100000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000001610001000000000000000000000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000161000100000000000000000001000000000000000000000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}},PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000016100010000000000000000000100000000000000000001000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000100000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = "a"}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000000010000000000000000000000000000000001610000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "61", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000000010000000000000000016100000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "", role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 0100000000000000010000000000000001000000000000000000000000000000010000000000000001000000000000000000010000000000000000000100000000000000000001010000000000000000000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "61", role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 010000000000000001000000000000000100000000000000000000000000000001000000000000000100000000000000000001000000000000000000010000000000000000000101000000000000000161000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000000001000000000000000161000100000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000010000000000000000000100000000000000016100010000000000000000000100000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [(TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}},PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}})], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000010000000000000000000000000000000100000000000000010000000000000001610001000000000000000000010000000000000000000100000000000000000000000000000000000000000000000000000000000000000001
 Show: MsgRespond (Just (Page {items = [Withdrawal {block = BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}, withdrawnPayouts = fromList [], withdrawalTx = ""}], nextRange = Nothing, totalCount = 1}))
 Binary: 0100000000000000010000000000000001000000000000000161000000000000000100000000000000000000000000000000000000000000000001
 Show: MsgRespond Nothing
@@ -5220,40 +5230,44 @@ Show: MsgRespond (Just (Page {items = [], nextRange = Just (Range {rangeStart =
 Binary: 01000000000000000001010000000000000000000100000000000000010000000000000001000000000000000001
 Show: MsgRespond (Just (Page {items = [], nextRange = Just (Range {rangeStart = Just (TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}), rangeOffset = 1, rangeLimit = 1, rangeDirection = Ascending}), totalCount = 1}))
 Binary: 0100000000000000000101000000000000000161000100000000000000010000000000000001000000000000000001
-Show: MsgRespond (Just (Page {items = [PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 010000000000000001000000000000000000010000000000000000000100000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = "a"}], nextRange = Nothing, totalCount = 1}))
-Binary: 01000000000000000100000000000000000001000000000000000000010000000000000000000000000000000161000000000000000001
-Show: MsgRespond (Just (Page {items = [PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "61", role = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 01000000000000000100000000000000000001000000000000000000010000000000000001610000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 01000000000000000100000000000000000001000000000000000161000100000000000000000000000000000000000000000000000001
-Show: MsgRespond (Just (Page {items = [PayoutRef {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payout = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, rolesCurrency = "", role = ""}], nextRange = Nothing, totalCount = 1}))
-Binary: 01000000000000000100000000000000016100010000000000000000000100000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000000001000000000000000000010000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = "a"}}], nextRange = Nothing, totalCount = 1}))
+Binary: 0100000000000000010000000000000000000100000000000000000001000000000000000000000000000000000161000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "61", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 0100000000000000010000000000000000000100000000000000000001000000000000000001610000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "", role = AssetId {policyId = "", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 010000000000000001000000000000000000010000000000000000000101000000000000000000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "61", role = AssetId {policyId = "", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 01000000000000000100000000000000000001000000000000000000010100000000000000016100000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 0100000000000000010000000000000000000100000000000000016100010000000000000000000000000000000000000000000000000001
+Show: MsgRespond (Just (Page {items = [PayoutHeader {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, role = AssetId {policyId = "", tokenName = ""}}], nextRange = Nothing, totalCount = 1}))
+Binary: 0100000000000000010000000000000001610001000000000000000000010000000000000000000000000000000000000000000000000001
 Show: MsgRespond Nothing
 Binary: 00
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 010000000100000000000000000001000000000000000000010000000000000000000000000000000100000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Just ""})))
-Binary: 0100000001000000000000000000010000000000000000000100000000000000000000000000000001000000000000000000000000000000000000000000000000010000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Just "61"})))
-Binary: 010000000100000000000000000001000000000000000000010000000000000000000000000000000100000000000000000000000000000000000000000000000001000000000000000161
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = "a"}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000010000000000000000000000000000000000000000000000016100
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "61", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000010000000000000000000000000000000161000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "", tokenName = ""},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 010000000100000000000000000001000000000000000000010000000000000000000000000000000100000000000000010000000000000000000000000000000000000000000000010000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "", tokenName = "a"},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000010000000000000001000000000000000000000000000000016100000000000000010000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "61", tokenName = ""},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000010000000000000001000000000000000161000000000000000000000000000000010000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "61", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000000001000000000000000161000000000000000100000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000000000100000000000000016100010000000000000000000000000000000100000000000000000000000000000000000000000000000000
-Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}, withdrawalId = Nothing})))
-Binary: 01000000010000000000000001610001000000000000000000010000000000000000000000000000000100000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 010000000100000000000000000001000000000000000000010000000000000000000000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = "a"}}})))
+Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000000100000000000000000000000000000000000000000000000161
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "61", tokenName = ""}}})))
+Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000000100000000000000000000000000000001610000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "", tokenName = ""},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 010000000100000000000000000001000000000000000000010000000000000000000000000000000001000000000000000100000000000000000000000000000000000000000000000100000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "", tokenName = "a"},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000000100000000000000010000000000000000000000000000000161000000000000000100000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList [(AssetId {policyId = "61", tokenName = ""},Quantity {unQuantity = 1})]}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 01000000010000000000000000000100000000000000000001000000000000000000000000000000000100000000000000010000000000000001610000000000000000000000000000000100000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "61", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 01000000010000000000000000000100000000000000000001000000000000000001610000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "", payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 0100000001000000000000000000010000000000000000000101000000000000000000000000000000000000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Just "61", payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 010000000100000000000000000001000000000000000000010100000000000000016100000000000000000000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 01000000010000000000000000000100000000000000016100010000000000000000000000000000000001000000000000000000000000000000000000000000000000
+Show: MsgRespond (Just (SomePayoutState MarloweV1 (PayoutState {contractId = ContractId {unContractId = TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}}, payoutId = TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}, withdrawalId = Nothing, payout = Payout {address = "", assets = Assets {ada = Lovelace {unLovelace = 1}, tokens = Tokens {unTokens = fromList []}}, datum = AssetId {policyId = "", tokenName = ""}}})))
+Binary: 01000000010000000000000001610001000000000000000000010000000000000000000000000000000001000000000000000000000000000000000000000000000000
 Show: MsgRespond (RuntimeStatus {nodeTip = Genesis, nodeTipUTC = 2000-01-01 00:00:01 UTC, runtimeChainTip = Genesis, runtimeChainTipUTC = 2000-01-01 00:00:01 UTC, runtimeTip = Genesis, runtimeTipUTC = 2000-01-01 00:00:01 UTC, networkId = Mainnet, runtimeVersion = Version {versionBranch = [], versionTags = []}})
 Binary: 0000000007d00000000000000001010100000000000000050010a5d4e80000000007d00000000000000001010100000000000000050010a5d4e80000000007d00000000000000001010100000000000000050010a5d4e80000000000000000000000000000000000
 Show: MsgRespond (RuntimeStatus {nodeTip = Genesis, nodeTipUTC = 2000-01-01 00:00:01 UTC, runtimeChainTip = Genesis, runtimeChainTipUTC = 2000-01-01 00:00:01 UTC, runtimeTip = Genesis, runtimeTipUTC = 2000-01-01 00:00:01 UTC, networkId = Mainnet, runtimeVersion = Version {versionBranch = [], versionTags = [""]}})

From 13cc2c45908f77abc30e003489835e70a7138877 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Mon, 28 Aug 2023 08:10:51 -0600
Subject: [PATCH 10/10] Remove focus usage

---
 .../test/Language/Marlowe/Runtime/Integration/Withdraw.hs       | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
index 68e5f2ac9d..950eab3326 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/Withdraw.hs
@@ -45,7 +45,7 @@ import Test.Hspec
 import Test.Integration.Marlowe.Local (MarloweRuntime, withLocalMarloweRuntime)
 
 spec :: Spec
-spec = focus $ describe "Withdraw" $ aroundAll setup do
+spec = describe "Withdraw" $ aroundAll setup do
   it "Fails on empty payouts" noPayoutsTest
   it "Fails on non-payout script outputs" nonPayoutTest
   it "Fails on non-script outputs" nonScriptPayoutTest