additional work on txout address

Cmdv · Cmdv · commit d4a5d9b8aa61 · 2024-09-19T10:28:45.000+01:00
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs
@@ -304,19 +304,19 @@ mkConfigFile staticDir cliConfigFilename =
 
 configPruneForceTxIn :: SyncNodeConfig -> SyncNodeConfig
 configPruneForceTxIn cfg = do
-  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutPrune (ForceTxIn True)}}
+  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutConsumedPrune (ForceTxIn True) (UseTxOutAddress False)}}
 
 configPrune :: SyncNodeConfig -> SyncNodeConfig
 configPrune cfg = do
-  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutPrune (ForceTxIn False)}}
+  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutConsumedPrune (ForceTxIn False) (UseTxOutAddress False)}}
 
 configConsume :: SyncNodeConfig -> SyncNodeConfig
 configConsume cfg = do
-  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutConsumed (ForceTxIn False)}}
+  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutConsumed (ForceTxIn False) (UseTxOutAddress False)}}
 
 configBootstrap :: SyncNodeConfig -> SyncNodeConfig
 configBootstrap cfg = do
-  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutBootstrap (ForceTxIn False)}}
+  cfg {dncInsertOptions = (dncInsertOptions cfg) {sioTxOut = TxOutConsumedBootstrap (ForceTxIn False) (UseTxOutAddress False)}}
 
 configPlutusDisable :: SyncNodeConfig -> SyncNodeConfig
 configPlutusDisable cfg = do
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage.hs
@@ -35,8 +35,7 @@ unitTests iom knownMigrations =
         , testCase "insert config" Config.insertConfig
         , testGroup
             "consumed-tx-out and prune-tx-out"
-            [ test "flag check" MigrateConsumedPruneTxOut.txConsumedColumnCheck
-            , test "basic prune" MigrateConsumedPruneTxOut.basicPrune
+            [ test "basic prune" MigrateConsumedPruneTxOut.basicPrune
             , test "prune with simple rollback" MigrateConsumedPruneTxOut.pruneWithSimpleRollback
             , test "prune with full tx rollback" MigrateConsumedPruneTxOut.pruneWithFullTxRollback
             , test "pruning should keep some tx" MigrateConsumedPruneTxOut.pruningShouldKeepSomeTx
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Config/MigrateConsumedPruneTxOut.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Config/MigrateConsumedPruneTxOut.hs
@@ -6,7 +6,6 @@
 #endif
 
 module Test.Cardano.Db.Mock.Unit.Babbage.Config.MigrateConsumedPruneTxOut (
-  txConsumedColumnCheck,
   basicPrune,
   pruneWithSimpleRollback,
   pruneWithFullTxRollback,
@@ -43,7 +42,6 @@ import Test.Cardano.Db.Mock.Config (
   stopDBSync,
   txOutTableTypeFromConfig,
   withCustomConfig,
-  withCustomConfigAndDropDB,
  )
 import Test.Cardano.Db.Mock.Examples (mockBlock0, mockBlock1)
 import Test.Cardano.Db.Mock.UnifiedApi (
@@ -60,20 +58,6 @@ import Test.Tasty.HUnit (Assertion)
 ------------------------------------------------------------------------------
 -- Tests
 ------------------------------------------------------------------------------
-txConsumedColumnCheck :: IOManager -> [(Text, Text)] -> Assertion
-txConsumedColumnCheck = do
-  withCustomConfigAndDropDB cmdLineArgs (Just configConsume) babbageConfigDir testLabel $ \interpreter mockServer dbSyncEnv -> do
-    void $
-      withBabbageFindLeaderAndSubmitTx interpreter mockServer $
-        Babbage.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 10000 500
-
-    startDBSync dbSyncEnv
-    assertBlockNoBackoff dbSyncEnv 1
-    assertEqQuery dbSyncEnv DB.queryTxConsumedColumnExists True "missing consumed_by_tx_id column when flag --consumed-tx-out active"
-  where
-    cmdLineArgs = initCommandLineArgs
-    testLabel = "configTxConsumedColumnCheck"
-
 basicPrune :: IOManager -> [(Text, Text)] -> Assertion
 basicPrune = do
   withCustomConfig cmdLineArgs (Just configPruneForceTxIn) babbageConfigDir testLabel $ \interpreter mockServer dbSyncEnv -> do
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs
@@ -44,8 +44,7 @@ unitTests iom knownMigrations =
             ]
         , testGroup
             "tx-out"
-            [ test "consumed_by_tx_id column check" MigrateConsumedPruneTxOut.txConsumedColumnCheck
-            , test "basic prune" MigrateConsumedPruneTxOut.basicPrune
+            [ test "basic prune" MigrateConsumedPruneTxOut.basicPrune
             , test "prune with simple rollback" MigrateConsumedPruneTxOut.pruneWithSimpleRollback
             , test "prune with full tx rollback" MigrateConsumedPruneTxOut.pruneWithFullTxRollback
             , test "pruning should keep some tx" MigrateConsumedPruneTxOut.pruningShouldKeepSomeTx
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/MigrateConsumedPruneTxOut.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/MigrateConsumedPruneTxOut.hs
@@ -6,7 +6,6 @@
 #endif
 
 module Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut (
-  txConsumedColumnCheck,
   basicPrune,
   pruneWithSimpleRollback,
   pruneWithFullTxRollback,
@@ -38,27 +37,6 @@ import qualified Prelude
 ------------------------------------------------------------------------------
 -- Tests
 -----------------------------------------------------------------------------
-txConsumedColumnCheck :: IOManager -> [(Text, Text)] -> Assertion
-txConsumedColumnCheck = do
-  -- be mindful that you have to manually pass the ioManager + names
-  withCustomConfigAndDropDB cmdLineArgs (Just configConsume) conwayConfigDir testLabel $
-    \interpreter mockServer dbSync -> do
-      startDBSync dbSync
-
-      void $
-        withConwayFindLeaderAndSubmitTx interpreter mockServer $
-          Conway.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 10_000 500 0
-
-      assertBlockNoBackoff dbSync 1
-      assertEqQuery
-        dbSync
-        DB.queryTxConsumedColumnExists
-        True
-        "missing consumed_by_tx_id column when tx-out = consumed"
-  where
-    cmdLineArgs = initCommandLineArgs
-    testLabel = "conwayTxConsumedColumnCheck"
-
 basicPrune :: IOManager -> [(Text, Text)] -> Assertion
 basicPrune = do
   withCustomConfig args (Just configPruneForceTxIn) cfgDir testLabel $ \interpreter mockServer dbSync -> do
diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Plutus.hs
@@ -63,6 +63,7 @@ import Test.Cardano.Db.Mock.Config (
   conwayConfigDir,
   initCommandLineArgs,
   startDBSync,
+  txOutTableTypeFromConfig,
   withCustomConfig,
   withFullConfig,
   withFullConfigAndDropDB,
diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs
@@ -117,7 +117,7 @@ isConsistent env = do
 
 getIsConsumedFixed :: SyncEnv -> IO (Maybe Word64)
 getIsConsumedFixed env =
-  case (DB.pcmPruneTxOut pcm, DB.pcmConsumeOrPruneTxOut pcm) of
+  case (DB.pcmPruneTxOut pcm, DB.pcmConsumedTxOut pcm) of
     (False, True) -> Just <$> DB.runDbIohkNoLogging backend (Multiplex.queryWrongConsumedBy txOutTableType)
     _ -> pure Nothing
   where
@@ -168,8 +168,7 @@ initPruneConsumeMigration :: Bool -> Bool -> Bool -> Bool -> DB.PruneConsumeMigr
 initPruneConsumeMigration consumed pruneTxOut bootstrap forceTxIn' =
   DB.PruneConsumeMigration
     { DB.pcmPruneTxOut = pruneTxOut || bootstrap
-    , DB.pcmConsumedTxOut = consumed
-    , DB.pcmConsumeOrPruneTxOut = consumed || pruneTxOut || bootstrap
+    , DB.pcmConsumedTxOut = consumed || pruneTxOut || bootstrap
     , DB.pcmSkipTxIn = not forceTxIn' && (consumed || pruneTxOut || bootstrap)
     }
 
@@ -204,7 +203,7 @@ getPruneInterval syncEnv = 10 * getSecurityParam syncEnv
 
 whenConsumeOrPruneTxOut :: (MonadIO m) => SyncEnv -> m () -> m ()
 whenConsumeOrPruneTxOut env =
-  when (DB.pcmConsumeOrPruneTxOut $ getPruneConsume env)
+  when (DB.pcmConsumedTxOut $ getPruneConsume env)
 
 whenPruneTxOut :: (MonadIO m) => SyncEnv -> m () -> m ()
 whenPruneTxOut env =
@@ -215,7 +214,7 @@ getTxOutTableType syncEnv = ioTxOutTableType . soptInsertOptions $ envOptions sy
 
 getHasConsumedOrPruneTxOut :: SyncEnv -> Bool
 getHasConsumedOrPruneTxOut =
-  DB.pcmConsumeOrPruneTxOut . getPruneConsume
+  DB.pcmConsumedTxOut . getPruneConsume
 
 getSkipTxIn :: SyncEnv -> Bool
 getSkipTxIn =
diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs
@@ -112,7 +112,7 @@ insertValidateGenesisDist syncEnv (NetworkName networkName) cfg = do
               "Initial genesis distribution populated. Hash "
                 <> renderByteArray (configGenesisHash cfg)
 
-            supply <- lift $ DB.queryGenesisSupply $ getTxOutTableType syncEnv
+            supply <- lift $ DB.queryTotalSupply $ getTxOutTableType syncEnv
             liftIO $ logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda supply)
 
 -- | Validate that the initial Genesis distribution in the DB matches the Genesis data.
diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs
@@ -159,8 +159,6 @@ insertValidateGenesisDist syncEnv networkName cfg shelleyInitiation = do
                   <> renderByteArray (configGenesisHash cfg)
               when hasStakes $
                 insertStaking tracer useNoCache bid cfg
-              supply <- lift $ DB.queryTotalSupply (getTxOutTableType syncEnv)
-              liftIO $ logInfo tracer ("Total genesis supply of Ada: " <> DB.renderAda supply)
 
 -- | Validate that the initial Genesis distribution in the DB matches the Genesis data.
 validateGenesisDistribution ::
diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Grouped.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Grouped.hs
@@ -64,7 +64,6 @@ data MissingMaTxOut = MissingMaTxOut
 data ExtendedTxOut = ExtendedTxOut
   { etoTxHash :: !ByteString
   , etoTxOut :: !DB.TxOutW
-  , etoPaymentCred :: !(Maybe ByteString)
   }
 
 data ExtendedTxIn = ExtendedTxIn
diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs
@@ -260,8 +260,8 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma
   -- TODO: Unsure about what we should return here for eutxo
   let !eutxo =
         case ioTxOutTableType iopts of
-          DB.TxOutCore -> ExtendedTxOut txHash txOut Nothing
-          DB.TxOutVariantAddress -> ExtendedTxOut txHash txOut $ Generic.maybePaymentCred addr
+          DB.TxOutCore -> ExtendedTxOut txHash txOut
+          DB.TxOutVariantAddress -> ExtendedTxOut txHash txOut
   !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ insertMaTxOuts tracer cache maMap
   pure (eutxo, maTxOuts)
   where
diff --git a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs
@@ -13,7 +13,7 @@
 
 module Cardano.Db.Operations.Other.ConsumedTxOut where
 
-import Cardano.BM.Trace (Trace, logError, logInfo, logWarning)
+import Cardano.BM.Trace (Trace, logInfo)
 import Cardano.Db.Error (LookupFail (..), logAndThrowIO)
 import Cardano.Db.Operations.Insert (insertExtraMigration)
 import Cardano.Db.Operations.Query (listToMaybe, queryAllExtraMigrations, queryBlockHeight, queryBlockNo, queryMaxRefId)
@@ -52,22 +52,6 @@ data ConsumedTriplet = ConsumedTriplet
 --------------------------------------------------------------------------------------------------
 -- Queries
 --------------------------------------------------------------------------------------------------
-queryUpdateListTxOutConsumedByTxId :: MonadIO m => [(TxOutIdW, TxId)] -> ReaderT SqlBackend m ()
-queryUpdateListTxOutConsumedByTxId ls = do
-  mapM_ (uncurry updateTxOutConsumedByTxId) ls
-
-queryTxConsumedColumnExists :: MonadIO m => ReaderT SqlBackend m Bool
-queryTxConsumedColumnExists = do
-  columnExists :: [Text] <-
-    fmap unSingle
-      <$> rawSql
-        ( mconcat
-            [ "SELECT column_name FROM information_schema.columns "
-            , "WHERE table_name='tx_out' and column_name='consumed_by_tx_id'"
-            ]
-        )
-        []
-  pure (not $ null columnExists)
 
 -- | This is a count of the null consumed_by_tx_id
 queryTxOutConsumedNullCount :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64
@@ -112,12 +96,14 @@ querySetNullTxOut trce txOutTableType mMinTxId = do
 
 updateListTxOutConsumedByTxId :: MonadIO m => [(TxOutIdW, TxId)] -> ReaderT SqlBackend m ()
 updateListTxOutConsumedByTxId ls = do
-  queryUpdateListTxOutConsumedByTxId ls
+  mapM_ (uncurry updateTxOutConsumedByTxId) ls
 
 runExtraMigrations :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> TxOutTableType -> Word64 -> PruneConsumeMigration -> ReaderT SqlBackend m ()
 runExtraMigrations trce txOutTableType blockNoDiff pcm = do
   ems <- queryAllExtraMigrations
   let migrationValues = processMigrationValues ems pcm
+  -- Make sure the config address_table is there if the migration wasn't previously set in teh db
+  when (not (isTxOutVariantAddress txOutTableType) && isTxOutAddressPreviouslySet migrationValues) $ throw $ DBExtraMigration "The configuration option 'tx_out.address_table' was previously set and the database updated. Unfortunately reverting this isn't possible."
   -- Has the user given txout address config && the migration wasn't previously set
   when (isTxOutVariantAddress txOutTableType && not (isTxOutAddressPreviouslySet migrationValues)) $ do
     updateTxOutAndCreateAddress
@@ -133,7 +119,7 @@ runExtraMigrations trce txOutTableType blockNoDiff pcm = do
     handleMigration :: (MonadBaseControl IO m, MonadIO m) => MigrationValues -> ReaderT SqlBackend m ()
     handleMigration migrationValues@MigrationValues {..} = do
       let PruneConsumeMigration {..} = pruneConsumeMigration
-      case (isConsumeTxOutPreviouslySet, pcmConsumeOrPruneTxOut, pcmPruneTxOut) of
+      case (isConsumeTxOutPreviouslySet, pcmConsumedTxOut, pcmPruneTxOut) of
         -- No Migration Needed
         (False, False, False) -> do
           liftIO $ logInfo trce "runExtraMigrations: No extra migration specified"
@@ -219,7 +205,7 @@ setNullTxOutConsumedAfter txOutTableType txOutId =
 
 migrateTxOutTests :: (MonadIO m, MonadBaseControl IO m) => TxOutTableType -> ReaderT SqlBackend m ()
 migrateTxOutTests txOutTableType = do
-  _ <- createConsumedTxOut
+  _ <- createConsumedIndexTxOut
   migrateNextPageTxOut Nothing txOutTableType 0
 
 migrateTxOut ::
@@ -232,7 +218,7 @@ migrateTxOut ::
   ReaderT SqlBackend m ()
 migrateTxOut trce txOutTableType _mMvs = do
   liftIO $ logInfo trce "migrateTxOut:"
-  _ <- createConsumedTxOut
+  _ <- createConsumedIndexTxOut
   migrateNextPageTxOut (Just trce) txOutTableType 0
 
 migrateNextPageTxOut :: MonadIO m => Maybe (Trace IO Text) -> TxOutTableType -> Word64 -> ReaderT SqlBackend m ()
@@ -315,7 +301,7 @@ shouldCreateConsumedTxOut ::
 shouldCreateConsumedTxOut trce rcc =
   unless rcc $ do
     liftIO $ logInfo trce "Created ConsumedTxOut when handling page entries."
-    createConsumedTxOut
+    createConsumedIndexTxOut
 
 -- | Update
 updatePageEntries ::
@@ -347,34 +333,46 @@ deleteTxOutConsumed txOutTableType txOutId index = case txOutTableType of
 --------------------------------------------------------------------------------------------------
 -- Raw Queries
 --------------------------------------------------------------------------------------------------
-createConsumedTxOut ::
+
+createConsumedIndexTxOut ::
   forall m.
   ( MonadBaseControl IO m
   , MonadIO m
   ) =>
   ReaderT SqlBackend m ()
-createConsumedTxOut = do
+createConsumedIndexTxOut = do
   handle exceptHandler $ rawExecute createIndex []
-  handle exceptHandler $ rawExecute addConstraint []
   where
     createIndex =
       "CREATE INDEX IF NOT EXISTS idx_tx_out_consumed_by_tx_id ON tx_out (consumed_by_tx_id)"
 
+    exceptHandler :: SqlError -> ReaderT SqlBackend m a
+    exceptHandler e =
+      liftIO $ throwIO (DBPruneConsumed $ show e)
+
+createConsumedConstraintTxOut ::
+  forall m.
+  ( MonadBaseControl IO m
+  , MonadIO m
+  ) =>
+  ReaderT SqlBackend m ()
+createConsumedConstraintTxOut = do
+  handle exceptHandler $ rawExecute addConstraint []
+  where
     addConstraint =
-      ( Text.unlines
-          [ "do $$"
-          , "begin"
-          , "  if not exists ("
-          , "    select 1"
-          , "    from information_schema.table_constraints"
-          , "    where constraint_name = 'ma_tx_out_tx_out_id_fkey'"
-          , "      and table_name = 'ma_tx_out'"
-          , "  ) then"
-          , "    execute 'alter table ma_tx_out add constraint ma_tx_out_tx_out_id_fkey foreign key(tx_out_id) references tx_out(id) on delete cascade on update restrict';"
-          , "  end if;"
-          , "end $$;"
-          ]
-      )
+      Text.unlines
+        [ "do $$"
+        , "begin"
+        , "  if not exists ("
+        , "    select 1"
+        , "    from information_schema.table_constraints"
+        , "    where constraint_name = 'ma_tx_out_tx_out_id_fkey'"
+        , "      and table_name = 'ma_tx_out'"
+        , "  ) then"
+        , "    execute 'alter table ma_tx_out add constraint ma_tx_out_tx_out_id_fkey foreign key(tx_out_id) references tx_out(id) on delete cascade on update restrict';"
+        , "  end if;"
+        , "end $$;"
+        ]
 
     exceptHandler :: SqlError -> ReaderT SqlBackend m a
     exceptHandler e =
@@ -505,37 +503,3 @@ countConsumed = \case
         where_ (isJust $ txOut ^. txOutConsumedByTxIdField @a)
         pure countRows
       pure $ maybe 0 unValue (listToMaybe res)
-
-_validateMigration :: MonadIO m => Trace IO Text -> TxOutTableType -> ReaderT SqlBackend m Bool
-_validateMigration trce txOutTableType = do
-  _migrated <- queryTxConsumedColumnExists
-  txInCount <- countTxIn
-  consumedTxOut <- countConsumed txOutTableType
-  if txInCount > consumedTxOut
-    then do
-      liftIO $
-        logWarning trce $
-          mconcat
-            [ "Found incomplete TxOut migration. There are"
-            , textShow txInCount
-            , " TxIn, but only"
-            , textShow consumedTxOut
-            , " consumed TxOut"
-            ]
-      pure False
-    else
-      if txInCount == consumedTxOut
-        then do
-          liftIO $ logInfo trce "Found complete TxOut migration"
-          pure True
-        else do
-          liftIO $
-            logError trce $
-              mconcat
-                [ "The impossible happened! There are"
-                , textShow txInCount
-                , " TxIn, but "
-                , textShow consumedTxOut
-                , " consumed TxOut"
-                ]
-          pure False
diff --git a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs
@@ -398,14 +398,6 @@ queryAddressId addrRaw = do
     pure (addr ^. V.AddressId)
   pure $ unValue <$> listToMaybe res
 
-queryAddressById :: MonadIO m => V.AddressId -> ReaderT SqlBackend m (Maybe V.Address)
-queryAddressById addrId = do
-  res <- select $ do
-    addr <- from $ table @V.Address
-    where_ (addr ^. V.AddressId ==. val addrId)
-    pure addr
-  pure $ entityVal <$> listToMaybe res
-
 --------------------------------------------------------------------------------
 -- queryAddressOutputs
 --------------------------------------------------------------------------------
diff --git a/cardano-db/src/Cardano/Db/Types.hs b/cardano-db/src/Cardano/Db/Types.hs

Original file line number	Diff line number	Diff line change
`@@ -64,7 +64,6 @@ data MissingMaTxOut = MissingMaTxOut`
`64`	`64`	`data ExtendedTxOut = ExtendedTxOut`
`65`	`65`	`{ etoTxHash :: !ByteString`
`66`	`66`	`, etoTxOut :: !DB.TxOutW`
`67`		`- , etoPaymentCred :: !(Maybe ByteString)`
`68`	`67`	`}`
`69`	`68`
`70`	`69`	`data ExtendedTxIn = ExtendedTxIn`