WIP: Omit disabled columns from schema

cabal.project

@@ -98,3 +98,13 @@ source-repository-package
     trace-dispatcher
     trace-forward
     trace-resources
+
+
+source-repository-package
+  type: git
+  location: https://github.com/sgillespie/persistent
+  tag: 0202aaca65bb3dc289c7a1611c56101efe5f146e
+  --sha256: sha256-MXp0dubopTh+wcnPTDh10y2qN17WKd1q+p8UYufWzKM=
+  subdir:
+    persistent
+    persistent-postgresql

cardano-chain-gen/cardano-chain-gen.cabal

@@ -157,6 +157,7 @@ test-suite cardano-chain-gen
                         Test.Cardano.Db.Mock.Unit.Conway.Config.JsonbInSchema
                         Test.Cardano.Db.Mock.Unit.Conway.Config.Parse
                         Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut
+                        Test.Cardano.Db.Mock.Unit.Conway.Config.TxOutConsumed
                         Test.Cardano.Db.Mock.Unit.Conway.Governance
                         Test.Cardano.Db.Mock.Unit.Conway.InlineAndReference
                         Test.Cardano.Db.Mock.Unit.Conway.Other

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -1,4 +1,9 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.Mock.Query (
@@ -17,6 +22,7 @@ module Cardano.Mock.Query (
   queryEpochStateCount,
   queryCommitteeByTxHash,
   queryCommitteeMemberCountByTxHash,
+  queryConsumedTxOutCount,
 ) where
 
 import qualified Cardano.Db as Db
@@ -270,3 +276,16 @@ queryCommitteeMemberCountByTxHash txHash = do
     pure countRows
 
   pure (maybe 0 unValue res)
+
+queryConsumedTxOutCount :: MonadIO io => ReaderT SqlBackend io Word64
+queryConsumedTxOutCount = do
+  maybe 0 unSingle . head <$> rawSql @(Single Word64) q []
+  where
+    -- tx_out.consumed_by_tx_id may or may not exist, depending on the runtime configuration!
+    -- We use an obscure trick to avoid the error `column "consumed_by_tx_id" does not exist`
+    q =
+      "select count "
+        <> "from (select null as consumed_by_tx_id)"
+        <> "cross join lateral ("
+        <> "select count(*) from tx_out where consumed_by_tx_id is not null"
+        <> ") as count"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs

@@ -7,6 +7,7 @@ import qualified Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.EpochDisabled a
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.JsonbInSchema as Config
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut as MigrateConsumedPruneTxOut
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.Parse as Config
+import qualified Test.Cardano.Db.Mock.Unit.Conway.Config.TxOutConsumed as TxOutConsumed
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Governance as Governance
 import qualified Test.Cardano.Db.Mock.Unit.Conway.InlineAndReference as InlineRef
 import qualified Test.Cardano.Db.Mock.Unit.Conway.Other as Other
@@ -85,6 +86,11 @@ unitTests iom knownMigrations =
                 "populate db then reset with use_address_table config config active"
                 $ MigrateConsumedPruneTxOut.populateDbRestartWithAddressConfig iom knownMigrations
             ]
+        , testGroup
+            "tx-out consumed by tx id"
+            [ test "without txout-consumed" TxOutConsumed.consumeTx
+            , test "with txout-consumed" TxOutConsumed.consumeTxConsumed
+            ]
         ]
     , testGroup
         "simple"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/TxOutConsumed.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Test.Cardano.Db.Mock.Unit.Conway.Config.TxOutConsumed (
+  consumeTx,
+  consumeTxConsumed,
+) where
+
+import Cardano.Mock.ChainSync.Server (IOManager ())
+import Cardano.Mock.Forging.Interpreter (withConwayLedgerState)
+import qualified Cardano.Mock.Forging.Tx.Conway as Conway
+import Cardano.Mock.Forging.Types (ForgingError (..), UTxOIndex (..))
+import qualified Cardano.Mock.Query as Query
+import Cardano.Prelude
+import Test.Cardano.Db.Mock.Config
+import qualified Test.Cardano.Db.Mock.UnifiedApi as Api
+import Test.Cardano.Db.Mock.Validate
+import Test.Tasty.HUnit (Assertion ())
+import Prelude ()
+
+consumeTx :: IOManager -> [(Text, Text)] -> Assertion
+consumeTx =
+  withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do
+    startDBSync dbSync
+
+    -- Forge a payment transaction
+    tx0 <-
+      withConwayLedgerState interpreter $
+        Conway.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 20_000 20_000 0
+
+    -- Forge a block with a transaction
+    void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ -> Right tx0
+    void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \state' -> do
+      utxo' <- maybeToEither CantFindUTxO (head $ Conway.mkUTxOConway tx0)
+      Conway.mkPaymentTx (UTxOPair utxo') (UTxOIndex 2) 10_000 500 0 state'
+
+    -- Verify the new transaction count
+    assertBlockNoBackoff dbSync 2
+
+    -- Should not have consumed_by_tx
+    assertEqBackoff
+      dbSync
+      Query.queryConsumedTxOutCount
+      0
+      []
+      "Unexpected consumed_by_tx count"
+  where
+    testLabel = "conwayConsumeTx"
+
+consumeTxConsumed :: IOManager -> [(Text, Text)] -> Assertion
+consumeTxConsumed =
+  withCustomConfigAndDropDB cmdLineArgs cfg conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do
+    startDBSync dbSync
+
+    -- Forge a payment transaction
+    tx0 <-
+      withConwayLedgerState interpreter $
+        Conway.mkPaymentTx (UTxOIndex 0) (UTxOIndex 1) 20_000 20_000 0
+
+    -- Forge a block with a transaction
+    void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \_ -> Right tx0
+    void $ Api.withConwayFindLeaderAndSubmitTx interpreter mockServer $ \state' -> do
+      utxo' <- maybeToEither CantFindUTxO (head $ Conway.mkUTxOConway tx0)
+      Conway.mkPaymentTx (UTxOPair utxo') (UTxOIndex 2) 10_000 500 0 state'
+
+    -- Wait for it to sync
+    assertBlockNoBackoff dbSync 2
+    assertTxCount dbSync 13
+
+    -- Should have consumed_by_tx
+    assertEqBackoff
+      dbSync
+      Query.queryConsumedTxOutCount
+      2
+      []
+      "Unexpected consumed_by_tx count"
+  where
+    cmdLineArgs = initCommandLineArgs
+    cfg = Just (configConsume False)
+    testLabel = "conwayConsumeTxConsumed"

cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTx

@@ -0,0 +1 @@
+[12,16]

cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTxConsumed

@@ -0,0 +1 @@
+[12,16]

cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs

@@ -137,7 +137,9 @@ runExtraMigrations trce txOutTableType blockNoDiff pcm = do
       case (isConsumeTxOutPreviouslySet, pcmConsumedTxOut, pcmPruneTxOut) of
         -- No Migration Needed
         (False, False, False) -> do
-          liftIO $ logInfo trce "runExtraMigrations: No extra migration specified"
+          liftIO $ logInfo trce "runExtraMigrations: Running extra migration no_consumed_tx_out"
+          insertExtraMigration NoConsumeTxOut
+          migrateTxOut trce txOutTableType (Just migrationValues)
         -- Already migrated
         (True, True, False) -> do
           liftIO $ logInfo trce "runExtraMigrations: Extra migration consumed_tx_out already executed"
@@ -255,7 +257,12 @@ migrateTxOut trce txOutTableType mMvs = do
     when (pcmPruneTxOut (pruneConsumeMigration mvs)) $ do
       liftIO $ logInfo trce "migrateTxOut: adding prune contraint on tx_out table"
       void createPruneConstraintTxOut
-  migrateNextPageTxOut (Just trce) txOutTableType 0
+    if pcmConsumedTxOut (pruneConsumeMigration mvs)
+      then do
+        migrateNextPageTxOut (Just trce) txOutTableType 0
+      else do
+        liftIO $ logInfo trce "migrateTxOut: removing column consumed_by_tx from tx_out table"
+        void (dropColumnConsumedByTxOut trce)
 
 migrateNextPageTxOut :: MonadIO m => Maybe (Trace IO Text) -> TxOutTableType -> Word64 -> ReaderT SqlBackend m ()
 migrateNextPageTxOut mTrce txOutTableType offst = do
@@ -415,6 +422,29 @@ createPruneConstraintTxOut = do
     exceptHandler e =
       liftIO $ throwIO (DBPruneConsumed $ show e)
 
+dropColumnConsumedByTxOut ::
+  forall io.
+  (MonadBaseControl IO io, MonadIO io) =>
+  Trace IO Text ->
+  ReaderT SqlBackend io ()
+dropColumnConsumedByTxOut trace = do
+  handle exceptionHandler (rawExecute dropViewsQuery [])
+  liftIO $ logInfo trace "dropColumnConsumedByTxOut: Dropped views"
+
+  handle exceptionHandler (rawExecute dropColumn [])
+  liftIO $ logInfo trace "dropColumnConsumedByTxOut: Altered tx_out"
+  where
+    dropColumn = "ALTER TABLE tx_out DROP COLUMN IF EXISTS consumed_by_tx_id;"
+
+    dropViewsQuery =
+      Text.unlines
+        [ "DROP VIEW IF EXISTS utxo_byron_view;"
+        , "DROP VIEW IF EXISTS utxo_view;"
+        ]
+
+    exceptionHandler :: SqlError -> ReaderT SqlBackend io a
+    exceptionHandler = liftIO . throwIO . DBPruneConsumed . show
+
 -- Be very mindfull that these queries can fail silently and make tests fail making it hard to know why.
 -- To help mitigate this, logs are printed after each query is ran, so one can know where it stopped.
 updateTxOutAndCreateAddress ::

cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs

@@ -41,7 +41,7 @@ share
     address             Text
     addressHasScript    Bool
     dataHash            ByteString Maybe    sqltype=hash32type
-    consumedByTxId      TxId Maybe          noreference
+    consumedByTxId      TxId Maybe          noreference default=null
     index               Word64              sqltype=txindex
     inlineDatumId       DatumId Maybe       noreference
     paymentCred         ByteString Maybe    sqltype=hash28type

cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs

@@ -39,7 +39,7 @@ share
 ----------------------------------------------
   TxOut
     addressId           AddressId           noreference
-    consumedByTxId      TxId Maybe          noreference
+    consumedByTxId      TxId Maybe          noreference default=null
     dataHash            ByteString Maybe    sqltype=hash32type
     index               Word64              sqltype=txindex
     inlineDatumId       DatumId Maybe       noreference

cardano-db/src/Cardano/Db/Types.hs

@@ -199,6 +199,7 @@ data ExtraMigration
   | BootstrapFinished
   | ConsumeTxOutPreviouslySet
   | TxOutAddressPreviouslySet
+  | NoConsumeTxOut
   deriving (Eq, Show, Read)
 
 data MigrationValues = MigrationValues
@@ -259,6 +260,8 @@ extraDescription = \case
     "The --consume-tx-out flag has previously been enabled"
   TxOutAddressPreviouslySet ->
     "The addition of a Address table for TxOuts was previously set"
+  NoConsumeTxOut ->
+    "The --consume-tx-out flag has previously been disabled"
 instance Ord PoolCert where
   compare a b = compare (pcCertNo a) (pcCertNo b)