Index parties from choices

input-output-hk · Nov 21, 2023 · 5844568 · 5844568
1 parent 7a40e19
commit 5844568
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 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
@@ -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
@@ -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