From 8c05deec89f16b30258adfe9700457f6f64a84fa Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Mon, 20 Nov 2023 12:06:07 -0500 Subject: [PATCH 1/6] Add parties in contract states to index --- .../Indexer/Database/PostgreSQL/CommitBlocks.hs | 7 ++++++- .../Language/Marlowe/Runtime/Indexer/Party.hs | 17 +++++++++++++---- marlowe-runtime/marlowe-runtime.cabal | 1 + 3 files changed, 20 insertions(+), 5 deletions(-) diff --git a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs index 0940171ee5..bf78ba566d 100644 --- a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs +++ b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs @@ -22,6 +22,7 @@ import Hasql.TH (resultlessStatement) import qualified Hasql.Transaction as H import Language.Marlowe.Core.V1.Plate (Extract (..)) import Language.Marlowe.Core.V1.Semantics (MarloweData (..), MarloweParams (..)) +import Language.Marlowe.Core.V1.Semantics.Types (Party, State (..)) import Language.Marlowe.Runtime.ChainSync.Api import Language.Marlowe.Runtime.Core.Api ( ContractId (..), @@ -43,6 +44,7 @@ import Language.Marlowe.Runtime.History.Api ( import Language.Marlowe.Runtime.Indexer.Party (ContractTxOutParty (ContractTxOutParty), commitParties) import Language.Marlowe.Runtime.Indexer.Types import PlutusLedgerApi.V2 (CurrencySymbol (..), fromBuiltin) +import qualified PlutusTx.AssocMap as AMap commitBlocks :: [MarloweBlock] -> H.Transaction () commitBlocks blocks = do @@ -283,7 +285,7 @@ transactionScriptOutputToRows contractId blockHeader@BlockHeader{..} payoutValid , toStrict $ runPut $ put $ toDatum marloweState , roleTokenMintingPolicyId , ContractTxOutParty TxOutRef{..} contractId roleTokenMintingPolicyId - <$> Set.toList (extractAll marloweContract) + <$> Set.toList (extractAll marloweContract <> stateParties marloweState) ) , assetsToTxOutAssetRows blockHeader txId' txIx' assets ) @@ -293,6 +295,9 @@ transactionScriptOutputToRows contractId blockHeader@BlockHeader{..} payoutValid txId' = unTxId txId txIx' = fromIntegral txIx +stateParties :: State -> Set.Set Party +stateParties State{..} = Set.fromList . fmap fst $ AMap.keys accounts + type CreateTxOutRow = ( ByteString -- txId , Int16 -- txIx diff --git a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs index a99eca88c4..649d338651 100644 --- a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs +++ b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs @@ -21,6 +21,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS import Data.Foldable (Foldable (..)) import Data.Int (Int16, Int64) +import Data.List (nub) import Data.Maybe (fromJust) import Data.Semigroup (Max (..)) import qualified Data.Set as Set @@ -32,11 +33,12 @@ import Hasql.TH (resultlessStatement, singletonStatement, vectorStatement) import qualified Hasql.Transaction as T import qualified Hasql.Transaction.Sessions as T import Language.Marlowe.Core.V1.Plate (Extract (..)) -import Language.Marlowe.Core.V1.Semantics.Types (Contract, Party (..)) +import Language.Marlowe.Core.V1.Semantics.Types (Contract, Party (..), State (..)) import Language.Marlowe.Core.V1.Semantics.Types.Address (serialiseAddress) import Language.Marlowe.Runtime.ChainSync.Api (SlotNo (..), TxId (..), TxOutRef (..), fromDatum) import Language.Marlowe.Runtime.Core.Api (ContractId (..)) import qualified PlutusLedgerApi.V2 as PV2 +import qualified PlutusTx.AssocMap as Map import UnliftIO (throwIO) indexParties :: (MonadIO m, WithLog env Message m) => Connection -> m () @@ -93,6 +95,7 @@ loadContracts fromSlot = COALESCE(createTxOut.txId, applyTx.createTxId) :: bytea, COALESCE(createTxOut.txIx, applyTx.createTxIx) :: smallint, contractTxOut.contract :: bytea, + contractTxOut.state :: bytea, blocks.slotNo :: bigint, contractTxOut.rolesCurrency :: bytea FROM marlowe.contractTxOut @@ -110,12 +113,14 @@ loadContracts fromSlot = AND contractTxOutPartyRole.txId IS NULL |] -decodeContractTxOut :: (ByteString, Int16, ByteString, Int16, ByteString, Int64, ByteString) -> ContractTxOut -decodeContractTxOut (txId, txIx, createTxId, createTxIx, contract, slotNo, rolesCurrency) = +decodeContractTxOut + :: (ByteString, Int16, ByteString, Int16, ByteString, ByteString, Int64, ByteString) -> ContractTxOut +decodeContractTxOut (txId, txIx, createTxId, createTxIx, contract, state, slotNo, rolesCurrency) = ContractTxOut { contractOut = TxOutRef (TxId txId) (fromIntegral txIx) , contractId = ContractId $ TxOutRef (TxId createTxId) (fromIntegral createTxIx) , contract = fromJust $ fromDatum $ runGet get $ LBS.fromStrict contract + , state = fromJust $ fromDatum $ runGet get $ LBS.fromStrict state , slotNo = fromIntegral slotNo , rolesCurrency } @@ -123,7 +128,9 @@ decodeContractTxOut (txId, txIx, createTxId, createTxIx, contract, slotNo, roles toEntries :: ContractTxOut -> (Max SlotNo, [ContractTxOutParty]) toEntries ContractTxOut{..} = ( Max slotNo - , [ContractTxOutParty{..} | party <- Set.toList $ extractAll contract] + , nub $ + [ContractTxOutParty{..} | party <- Set.toList $ extractAll contract] + <> [ContractTxOutParty{..} | party <- fmap fst . Map.keys $ accounts state] ) commitParties :: [ContractTxOutParty] -> T.Transaction () @@ -215,6 +222,7 @@ data ContractTxOut = ContractTxOut { contractOut :: TxOutRef , contractId :: ContractId , contract :: Contract + , state :: State , rolesCurrency :: ByteString , slotNo :: SlotNo } @@ -225,3 +233,4 @@ data ContractTxOutParty = ContractTxOutParty , rolesCurrency :: ByteString , party :: Party } + deriving (Eq) diff --git a/marlowe-runtime/marlowe-runtime.cabal b/marlowe-runtime/marlowe-runtime.cabal index be4cfc9798..3d4c3abac2 100644 --- a/marlowe-runtime/marlowe-runtime.cabal +++ b/marlowe-runtime/marlowe-runtime.cabal @@ -314,6 +314,7 @@ library indexer , mtl >=2.2 && <3 , nonempty-containers ^>=0.3.4 , plutus-ledger-api ^>=1.5 + , plutus-tx ^>=1.5 , stm ^>=2.5 , text ^>=1.2 , time >=1.9 && <2 From 1833f2dcfed5f56c9ca0350fde0af977ff1c2cfa Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Mon, 20 Nov 2023 12:11:04 -0500 Subject: [PATCH 2/6] Add migration to reset party index --- marlowe-runtime/marlowe-indexer/deploy/resetParties.sql | 9 +++++++++ marlowe-runtime/marlowe-indexer/revert/resetParties.sql | 7 +++++++ marlowe-runtime/marlowe-indexer/sqitch.plan | 1 + marlowe-runtime/marlowe-indexer/verify/resetParties.sql | 7 +++++++ 4 files changed, 24 insertions(+) create mode 100644 marlowe-runtime/marlowe-indexer/deploy/resetParties.sql create mode 100644 marlowe-runtime/marlowe-indexer/revert/resetParties.sql create mode 100644 marlowe-runtime/marlowe-indexer/verify/resetParties.sql diff --git a/marlowe-runtime/marlowe-indexer/deploy/resetParties.sql b/marlowe-runtime/marlowe-indexer/deploy/resetParties.sql new file mode 100644 index 0000000000..cd1ec60033 --- /dev/null +++ b/marlowe-runtime/marlowe-indexer/deploy/resetParties.sql @@ -0,0 +1,9 @@ +-- Deploy marlowe:resetParties to pg +-- requires: parties + +BEGIN; + +TRUNCATE TABLE marlowe.contractTxOutPartyAddress; +TRUNCATE TABLE marlowe.contractTxOutPartyRole; + +COMMIT; diff --git a/marlowe-runtime/marlowe-indexer/revert/resetParties.sql b/marlowe-runtime/marlowe-indexer/revert/resetParties.sql new file mode 100644 index 0000000000..f36a0bc44d --- /dev/null +++ b/marlowe-runtime/marlowe-indexer/revert/resetParties.sql @@ -0,0 +1,7 @@ +-- Revert marlowe:resetParties from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/marlowe-runtime/marlowe-indexer/sqitch.plan b/marlowe-runtime/marlowe-indexer/sqitch.plan index 9a045c8576..2ab2ccde12 100644 --- a/marlowe-runtime/marlowe-indexer/sqitch.plan +++ b/marlowe-runtime/marlowe-indexer/sqitch.plan @@ -11,3 +11,4 @@ indexRoleCurrency [schema] 2023-02-28T21:16:41Z Jamie Bertram # Adds contract tags table. tag-text [tags] 2023-07-11T12:37:05Z Jamie Bertram # Changes tags from varchar(64) to text. parties [schema] 2023-08-29T15:49:56Z Jamie Bertram # Adds party indexes. +resetParties [parties] 2023-11-20T17:09:21Z Jamie Bertram # Reset parties index diff --git a/marlowe-runtime/marlowe-indexer/verify/resetParties.sql b/marlowe-runtime/marlowe-indexer/verify/resetParties.sql new file mode 100644 index 0000000000..a1b05c1b08 --- /dev/null +++ b/marlowe-runtime/marlowe-indexer/verify/resetParties.sql @@ -0,0 +1,7 @@ +-- Verify marlowe:resetParties on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; From 3765610978623d663113fd679e0b25198d71d07f Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Mon, 20 Nov 2023 13:02:00 -0500 Subject: [PATCH 3/6] Update changelog --- ...0231120_130123_jhbertra_plt_8029_index_marlowe_accounts.md | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 marlowe-runtime/changelog.d/20231120_130123_jhbertra_plt_8029_index_marlowe_accounts.md diff --git a/marlowe-runtime/changelog.d/20231120_130123_jhbertra_plt_8029_index_marlowe_accounts.md b/marlowe-runtime/changelog.d/20231120_130123_jhbertra_plt_8029_index_marlowe_accounts.md new file mode 100644 index 0000000000..5915a902fc --- /dev/null +++ b/marlowe-runtime/changelog.d/20231120_130123_jhbertra_plt_8029_index_marlowe_accounts.md @@ -0,0 +1,4 @@ +### Changed + +- `marlowe-indexer` now indexes contracts by parties in the accounts as well as + the contract. From cd967017c8ae40d169e0f0d9aa09ffbfafe4e0d7 Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Mon, 20 Nov 2023 16:19:21 -0500 Subject: [PATCH 4/6] Use tee for test output redirection --- .github/workflows/test.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 11846a0776..5efbb7cece 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -61,9 +61,8 @@ jobs: - if: ${{ steps.cache-results.outputs.cache-hit != 'true' }} name: Run tests run: | - result/bin/marlowe-integration-tests --strict > ~/integration-tests.log + result/bin/marlowe-integration-tests --strict | tee ~/integration-tests.log echo $? > ~/integration-tests.status - cat ~/integration-tests.log exit $(cat ~/integration-tests.status) env: MARLOWE_RT_TEST_DB_HOST: localhost From 7a40e1916f2ed29df3142c5e6b8f074eaf3f4742 Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Mon, 20 Nov 2023 17:14:55 -0500 Subject: [PATCH 5/6] Update GetHeaders tests --- .github/workflows/test.yml | 1 + .../Language/Marlowe/Runtime/Integration/MarloweQuery.hs | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 5efbb7cece..6553a85d9b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -61,6 +61,7 @@ jobs: - if: ${{ steps.cache-results.outputs.cache-hit != 'true' }} name: Run tests run: | + set -o pipefail result/bin/marlowe-integration-tests --strict | tee ~/integration-tests.log echo $? > ~/integration-tests.status exit $(cat ~/integration-tests.status) 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 798bdcf47b..3c06895535 100644 --- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs +++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Integration/MarloweQuery.hs @@ -203,10 +203,10 @@ applyVariation filterSym = \case partyAddressesForContract :: RefSym GetHeaders -> Set PartyAddress partyAddressesForContract = \case - Contract1 -> Set.singleton Wallet2 - Contract2 -> Set.singleton Wallet1 - Contract3 -> Set.singleton Wallet2 - Contract4 -> mempty -- wallet 1 is not a *visible* party address of contract 4 due to merkleization. + Contract1 -> Set.fromList [Wallet1, Wallet2] + Contract2 -> Set.fromList [Wallet1, Wallet2] + Contract3 -> Set.fromList [Wallet1, Wallet2] + Contract4 -> Set.singleton Wallet2 -- wallet 1 is not a *visible* party address of contract 4 due to merkleization. instance PaginatedQuery GetWithdrawals where type Filter GetWithdrawals = WithdrawalFilter From 5844568d54729ebc263d2ded6451553c28e2bcd8 Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Tue, 21 Nov 2023 10:19:31 -0500 Subject: [PATCH 6/6] Index parties from choices --- .../Indexer/Database/PostgreSQL/CommitBlocks.hs | 10 ++++++++-- .../indexer/Language/Marlowe/Runtime/Indexer/Party.hs | 6 +++++- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs index bf78ba566d..096365eb80 100644 --- a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs +++ b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Database/PostgreSQL/CommitBlocks.hs @@ -22,7 +22,7 @@ import Hasql.TH (resultlessStatement) import qualified Hasql.Transaction as H import Language.Marlowe.Core.V1.Plate (Extract (..)) import Language.Marlowe.Core.V1.Semantics (MarloweData (..), MarloweParams (..)) -import Language.Marlowe.Core.V1.Semantics.Types (Party, State (..)) +import Language.Marlowe.Core.V1.Semantics.Types (ChoiceId (..), Party, State (..)) import Language.Marlowe.Runtime.ChainSync.Api import Language.Marlowe.Runtime.Core.Api ( ContractId (..), @@ -296,7 +296,13 @@ transactionScriptOutputToRows contractId blockHeader@BlockHeader{..} payoutValid txIx' = fromIntegral txIx stateParties :: State -> Set.Set Party -stateParties State{..} = Set.fromList . fmap fst $ AMap.keys accounts +stateParties State{..} = + Set.fromList $ + (fst <$> AMap.keys accounts) + <> (choiceParty <$> AMap.keys choices) + +choiceParty :: ChoiceId -> Party +choiceParty (ChoiceId _ party) = party type CreateTxOutRow = ( ByteString -- txId diff --git a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs index 649d338651..fef6c04f0b 100644 --- a/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs +++ b/marlowe-runtime/indexer/Language/Marlowe/Runtime/Indexer/Party.hs @@ -33,7 +33,7 @@ import Hasql.TH (resultlessStatement, singletonStatement, vectorStatement) import qualified Hasql.Transaction as T import qualified Hasql.Transaction.Sessions as T import Language.Marlowe.Core.V1.Plate (Extract (..)) -import Language.Marlowe.Core.V1.Semantics.Types (Contract, Party (..), State (..)) +import Language.Marlowe.Core.V1.Semantics.Types (ChoiceId (..), Contract, Party (..), State (..)) import Language.Marlowe.Core.V1.Semantics.Types.Address (serialiseAddress) import Language.Marlowe.Runtime.ChainSync.Api (SlotNo (..), TxId (..), TxOutRef (..), fromDatum) import Language.Marlowe.Runtime.Core.Api (ContractId (..)) @@ -131,8 +131,12 @@ toEntries ContractTxOut{..} = , nub $ [ContractTxOutParty{..} | party <- Set.toList $ extractAll contract] <> [ContractTxOutParty{..} | party <- fmap fst . Map.keys $ accounts state] + <> [ContractTxOutParty{..} | party <- fmap choiceParty . Map.keys $ choices state] ) +choiceParty :: ChoiceId -> Party +choiceParty (ChoiceId _ party) = party + commitParties :: [ContractTxOutParty] -> T.Transaction () commitParties parties = T.statement params statement