diff --git a/cabal.project b/cabal.project index e897f7a98..aa025a34d 100644 --- a/cabal.project +++ b/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 diff --git a/cardano-chain-gen/cardano-chain-gen.cabal b/cardano-chain-gen/cardano-chain-gen.cabal index d23a3fe34..44f8aedf5 100644 --- a/cardano-chain-gen/cardano-chain-gen.cabal +++ b/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 diff --git a/cardano-chain-gen/src/Cardano/Mock/Query.hs b/cardano-chain-gen/src/Cardano/Mock/Query.hs index 46c645408..aaaaa8625 100644 --- a/cardano-chain-gen/src/Cardano/Mock/Query.hs +++ b/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" 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 index 96fb45ec8..97482e005 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway.hs +++ b/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" diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/TxOutConsumed.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/TxOutConsumed.hs new file mode 100644 index 000000000..893f1cfc3 --- /dev/null +++ b/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" diff --git a/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTx b/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTx new file mode 100644 index 000000000..c40a0a0ca --- /dev/null +++ b/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTx @@ -0,0 +1 @@ +[12,16] \ No newline at end of file diff --git a/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTxConsumed b/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTxConsumed new file mode 100644 index 000000000..c40a0a0ca --- /dev/null +++ b/cardano-chain-gen/test/testfiles/fingerprint/conwayConsumeTxConsumed @@ -0,0 +1 @@ +[12,16] \ No newline at end of file diff --git a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs index 47f68e513..71ebebbcc 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs +++ b/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 :: diff --git a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs index 57974fb82..0e287d670 100644 --- a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs +++ b/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 diff --git a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs index 875e71792..64fe82440 100644 --- a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs +++ b/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 diff --git a/cardano-db/src/Cardano/Db/Types.hs b/cardano-db/src/Cardano/Db/Types.hs index 8dd52f1d5..562f9c2fd 100644 --- a/cardano-db/src/Cardano/Db/Types.hs +++ b/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)