Fix withdrawalTxIn persistence bug

input-output-hk · Feb 6, 2023 · 7017715 · 7017715
1 parent 05bab5c
commit 7017715
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 9 deletions.
diff --git a/marlowe-integration/src/Test/Integration/Marlowe/Local.hs b/marlowe-integration/src/Test/Integration/Marlowe/Local.hs
@@ -275,7 +275,7 @@ withLocalMarloweRuntime' MarloweRuntimeOptions{..} test = withRunInIO \runInIO -
         (either (fail . show) pure <=< Pool.use pool)
         (Indexer.databaseQueries securityParameter)
 
-      marloweSyncDatabaseQueries = Sync.hoistDatabaseQueries
+      marloweSyncDatabaseQueries eventBackend = Sync.logDatabaseQueries eventBackend $ Sync.hoistDatabaseQueries
         (either (fail . show) pure <=< Pool.use pool)
         Sync.databaseQueries
 
@@ -448,6 +448,7 @@ data RuntimeSelector f where
   ChainIndexerEvent :: ChainIndexerSelector f -> RuntimeSelector f
   MarloweIndexerEvent :: MarloweIndexerSelector f -> RuntimeSelector f
   ConfigWatcher :: ConfigWatcherSelector f -> RuntimeSelector f
+  SyncDatabaseEvent :: Sync.DatabaseSelector f -> RuntimeSelector f
 
 data RuntimeDependencies r = RuntimeDependencies
   { acceptRunChainSeekServer :: IO (RunServer IO RuntimeChainSeekServer)
@@ -466,7 +467,7 @@ data RuntimeDependencies r = RuntimeDependencies
   , historyQueries :: HistoryQueries IO
   , localNodeConnectInfo :: LocalNodeConnectInfo CardanoMode
   , marloweIndexerDatabaseQueries :: Indexer.DatabaseQueries IO
-  , marloweSyncDatabaseQueries :: Sync.DatabaseQueries IO
+  , marloweSyncDatabaseQueries :: EventBackend IO r Sync.DatabaseSelector -> Sync.DatabaseQueries IO
   , mkSubmitJob :: Tx BabbageEra -> STM SubmitJob
   , rootEventBackend :: EventBackend IO r RuntimeSelector
   , runChainSeekClient :: RunClient IO RuntimeChainSeekClient
@@ -522,7 +523,7 @@ runtime = proc RuntimeDependencies{..} -> do
     }
 
   sync -< SyncDependencies
-    { databaseQueries = marloweSyncDatabaseQueries
+    { databaseQueries = marloweSyncDatabaseQueries $ narrowEventBackend SyncDatabaseEvent rootEventBackend
     , acceptRunMarloweSyncServer = acceptRunHistorySyncServer
     , acceptRunMarloweHeaderSyncServer = acceptRunDiscoverySyncServer
     , acceptRunMarloweQueryServer
@@ -721,6 +722,7 @@ getRuntimeSelectorConfig = \case
   TxEvent sel -> prependKey "marlowe-tx" $ getTransactionSererSelectorConfig sel
   ChainIndexerEvent sel -> prependKey "marlowe-chain-indexer" $ getChainIndexerSelectorConfig sel
   MarloweIndexerEvent sel -> prependKey "marlowe-indexer" $ getMarloweIndexerSelectorConfig sel
+  SyncDatabaseEvent sel -> prependKey "marlowe-sync-database" $ Sync.getDatabaseSelectorConfig sel
   ConfigWatcher ReloadConfig -> SelectorConfig "reload-log-config" True
     $ singletonFieldConfig "config" True
 

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
@@ -88,15 +88,15 @@ commitBlocks blocks = H.statement (prepareParams blocks)
         SELECT * FROM payoutTxOutInputs
       )
 
-    , withdrawalTxInInputs (txId, slotNo, blockId, blockNo, payoutTxId, payoutTxIx) AS
-      ( SELECT * FROM UNNEST ($46 :: bytea[], $47 :: bigint[], $48 :: bytea[], $49 :: bigint[], $50 :: bytea[], $51 :: smallint[])
+    , withdrawalTxInInputs (txId, slotNo, blockId, blockNo, payoutTxId, payoutTxIx, createTxId, createTxIx) AS
+      ( SELECT * FROM UNNEST ($46 :: bytea[], $47 :: bigint[], $48 :: bytea[], $49 :: bigint[], $50 :: bytea[], $51 :: smallint[], $52 :: bytea[], $53 :: smallint[])
       )
     , insertWithdrawalTxIns AS
-      ( INSERT INTO marlowe.withdrawalTxIn (txId, slotNo, blockId, blockNo, payoutTxId, payoutTxIx)
+      ( INSERT INTO marlowe.withdrawalTxIn (txId, slotNo, blockId, blockNo, payoutTxId, payoutTxIx, createTxId, createTxIx)
         SELECT * FROM withdrawalTxInInputs
       )
     , invalidApplyTxInputs (txId, inputTxId, inputTxIx, blockId, error) AS
-      ( SELECT * FROM UNNEST ($52 :: bytea[], $53 :: bytea[], $54 :: smallint[], $55 :: bytea[], $56 :: text[])
+      ( SELECT * FROM UNNEST ($54 :: bytea[], $55 :: bytea[], $56 :: smallint[], $57 :: bytea[], $58 :: text[])
       )
     INSERT INTO marlowe.invalidApplyTx (txId, inputTxId, inputTxIx, blockId, error)
     SELECT * FROM invalidApplyTxInputs
@@ -161,6 +161,8 @@ type QueryParams =
   , Vector Int64 -- withdrawalTxIn blockNo rows
   , Vector ByteString -- withdrawalTxIn payoutTxId rows
   , Vector Int16 -- withdrawalTxIn payoutTxIx rows
+  , Vector ByteString -- withdrawalTxIn createTxId rows
+  , Vector Int16 -- withdrawalTxIn createTxIx rows
 
   , Vector ByteString -- invalidApplyTx txId rows
   , Vector ByteString -- invalidApplyTx inputTxId rows
@@ -372,6 +374,8 @@ type WithdrawalTxInRow =
   , Int64 -- blockNo
   , ByteString -- payoutTxId
   , Int16 -- payoutTxIx
+  , ByteString -- createTxId
+  , Int16 -- createTxIx
   )
 
 type InvalidApplyTxRow =
@@ -387,13 +391,15 @@ withdrawTxToWithdrawalTxInRows
   -> MarloweWithdrawTransaction
   -> [WithdrawalTxInRow]
 withdrawTxToWithdrawalTxInRows BlockHeader{..} MarloweWithdrawTransaction{..} =
-  (Map.elems consumedPayouts >>= Set.toList) <&> \TxOutRef{..} ->
+  Map.toList consumedPayouts >>= \(ContractId (TxOutRef createTxId createTxIx), consumed) -> Set.toList consumed <&> \TxOutRef{..} ->
     ( unTxId consumingTx
     , fromIntegral slotNo
     , unBlockHeaderHash headerHash
     , fromIntegral blockNo
     , unTxId txId
     , fromIntegral txIx
+    , unTxId createTxId
+    , fromIntegral createTxIx
     )
 
 prepareParams :: [MarloweBlock] -> QueryParams
@@ -456,6 +462,8 @@ prepareParams blocks =
   , V.fromList withdrawalTxInBlockNoRows
   , V.fromList withdrawalTxInPayoutTxIdRows
   , V.fromList withdrawalTxInPayoutTxIxRows
+  , V.fromList withdrawalTxInCreateTxIdRows
+  , V.fromList withdrawalTxInCreateTxIxRows
 
   , V.fromList invalidApplyTxTxIdRows
   , V.fromList invalidApplyTxInputTxIdRows
@@ -536,7 +544,9 @@ prepareParams blocks =
       , withdrawalTxInBlockNoRows
       , withdrawalTxInPayoutTxIdRows
       , withdrawalTxInPayoutTxIxRows
-      ) = unzip6 withdrawalTxInRows
+      , withdrawalTxInCreateTxIdRows
+      , withdrawalTxInCreateTxIxRows
+      ) = unzip8 withdrawalTxInRows
 
     ( invalidApplyTxTxIdRows
       , invalidApplyTxInputTxIdRows
@@ -625,3 +635,18 @@ unzip13 = foldr
     )
   )
   ([], [], [], [], [], [], [], [], [], [], [], [], [])
+
+unzip8 :: [(a, b, c, d, e, f, g, h)] -> ([a], [b], [c], [d], [e], [f], [g], [h])
+unzip8 = foldr
+  (\(a, b, c, d, e, f, g, h) (as, bs, cs, ds, es, fs, gs, hs) ->
+    ( a : as
+    , b : bs
+    , c : cs
+    , d : ds
+    , e : es
+    , f : fs
+    , g : gs
+    , h : hs
+    )
+  )
+  ([], [], [], [], [], [], [], [])