diff --git a/.github/workflows/check-fourmolu.yml b/.github/workflows/check-fourmolu.yml index c24f77cef..3d52847b7 100644 --- a/.github/workflows/check-fourmolu.yml +++ b/.github/workflows/check-fourmolu.yml @@ -13,9 +13,9 @@ jobs: shell: bash steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - name: Run fourmolu - uses: haskell-actions/run-fourmolu@v9 + uses: haskell-actions/run-fourmolu@v11 with: - version: "0.10.1.0" + version: "0.17.0.0" diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs index 2dbd2ec70..956173f27 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs @@ -50,15 +50,15 @@ module Test.Cardano.Db.Mock.Config ( startDBSync, withDBSyncEnv, withFullConfig, - withFullConfigAndDropDB, - withFullConfigAndLogs, - withCustomConfigAndLogsAndDropDB, + withFullConfigDropDB, + withFullConfigLog, + withCustomConfigDropDBLog, withCustomConfig, - withCustomConfigAndDropDB, - withCustomConfigAndLogs, + withCustomConfigDropDB, + withCustomConfigLog, withFullConfig', replaceConfigFile, - txOutTableTypeFromConfig, + txOutVariantTypeFromConfig, ) where import Cardano.Api (NetworkMagic (..)) @@ -401,7 +401,7 @@ withFullConfig = Nothing -- this function needs to be used where the schema needs to be rebuilt -withFullConfigAndDropDB :: +withFullConfigDropDB :: -- | config filepath FilePath -> -- | test label @@ -410,7 +410,7 @@ withFullConfigAndDropDB :: IOManager -> [(Text, Text)] -> IO a -withFullConfigAndDropDB = +withFullConfigDropDB = withFullConfig' ( WithConfigArgs { hasFingerprint = True @@ -421,7 +421,7 @@ withFullConfigAndDropDB = initCommandLineArgs Nothing -withFullConfigAndLogs :: +withFullConfigLog :: -- | config filepath FilePath -> -- | test label @@ -430,7 +430,7 @@ withFullConfigAndLogs :: IOManager -> [(Text, Text)] -> IO a -withFullConfigAndLogs = +withFullConfigLog = withFullConfig' ( WithConfigArgs { hasFingerprint = True @@ -462,7 +462,7 @@ withCustomConfig = } ) -withCustomConfigAndDropDB :: +withCustomConfigDropDB :: CommandLineArgs -> -- | custom SyncNodeConfig Maybe (SyncNodeConfig -> SyncNodeConfig) -> @@ -474,7 +474,7 @@ withCustomConfigAndDropDB :: IOManager -> [(Text, Text)] -> IO a -withCustomConfigAndDropDB = +withCustomConfigDropDB = withFullConfig' ( WithConfigArgs { hasFingerprint = True @@ -484,7 +484,7 @@ withCustomConfigAndDropDB = ) -- This is a usefull function to be able to see logs from DBSync when writing/debuging tests -withCustomConfigAndLogs :: +withCustomConfigLog :: CommandLineArgs -> -- | custom SyncNodeConfig Maybe (SyncNodeConfig -> SyncNodeConfig) -> @@ -496,7 +496,7 @@ withCustomConfigAndLogs :: IOManager -> [(Text, Text)] -> IO a -withCustomConfigAndLogs = +withCustomConfigLog = withFullConfig' ( WithConfigArgs { hasFingerprint = True @@ -505,7 +505,7 @@ withCustomConfigAndLogs = } ) -withCustomConfigAndLogsAndDropDB :: +withCustomConfigDropDBLog :: CommandLineArgs -> -- | custom SyncNodeConfig Maybe (SyncNodeConfig -> SyncNodeConfig) -> @@ -517,7 +517,7 @@ withCustomConfigAndLogsAndDropDB :: IOManager -> [(Text, Text)] -> IO a -withCustomConfigAndLogsAndDropDB = +withCustomConfigDropDBLog = withFullConfig' ( WithConfigArgs { hasFingerprint = True @@ -604,14 +604,14 @@ replaceConfigFile newFilename dbSync@DBSyncEnv {..} = do newParams = dbSyncParams {enpConfigFile = ConfigFile $ configDir newFilename} -txOutTableTypeFromConfig :: DBSyncEnv -> DB.TxOutTableType -txOutTableTypeFromConfig dbSyncEnv = +txOutVariantTypeFromConfig :: DBSyncEnv -> DB.TxOutVariantType +txOutVariantTypeFromConfig dbSyncEnv = case sioTxOut $ dncInsertOptions $ dbSyncConfig dbSyncEnv of - TxOutDisable -> DB.TxOutCore + TxOutDisable -> DB.TxOutVariantCore TxOutEnable useTxOutAddress -> getTxOutTT useTxOutAddress TxOutConsumed _ useTxOutAddress -> getTxOutTT useTxOutAddress TxOutConsumedPrune _ useTxOutAddress -> getTxOutTT useTxOutAddress TxOutConsumedBootstrap _ useTxOutAddress -> getTxOutTT useTxOutAddress where - getTxOutTT :: UseTxOutAddress -> DB.TxOutTableType - getTxOutTT value = if unUseTxOutAddress value then DB.TxOutVariantAddress else DB.TxOutCore + getTxOutTT :: UseTxOutAddress -> DB.TxOutVariantType + getTxOutTT value = if unUseTxOutAddress value then DB.TxOutVariantAddress else DB.TxOutVariantCore diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Simple.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Simple.hs index 69e6620c6..530badf18 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Simple.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Simple.hs @@ -12,7 +12,7 @@ import Control.Concurrent.Class.MonadSTM.Strict (MonadSTM (atomically)) import Control.Monad (void) import Data.Text (Text) import Ouroboros.Network.Block (blockNo) -import Test.Cardano.Db.Mock.Config (alonzoConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigAndDropDB) +import Test.Cardano.Db.Mock.Config (alonzoConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigDropDB) import Test.Cardano.Db.Mock.Examples (mockBlock0, mockBlock1, mockBlock2) import Test.Cardano.Db.Mock.UnifiedApi (forgeNextAndSubmit) import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff) @@ -20,7 +20,7 @@ import Test.Tasty.HUnit (Assertion, assertBool) forgeBlocks :: IOManager -> [(Text, Text)] -> Assertion forgeBlocks = do - withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter _mockServer _dbSync -> do + withFullConfigDropDB alonzoConfigDir testLabel $ \interpreter _mockServer _dbSync -> do _block0 <- forgeNext interpreter mockBlock0 _block1 <- forgeNext interpreter mockBlock1 block2 <- forgeNext interpreter mockBlock2 diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Tx.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Tx.hs index e5c80d62d..e2738d1a4 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Tx.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Tx.hs @@ -18,7 +18,7 @@ import Test.Cardano.Db.Mock.Config ( alonzoConfigDir, startDBSync, withFullConfig, - withFullConfigAndDropDB, + withFullConfigDropDB, ) import Test.Cardano.Db.Mock.UnifiedApi ( withAlonzoFindLeaderAndSubmit, @@ -29,7 +29,7 @@ import Test.Tasty.HUnit (Assertion) addSimpleTx :: IOManager -> [(Text, Text)] -> Assertion addSimpleTx = - withFullConfigAndDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB alonzoConfigDir testLabel $ \interpreter mockServer dbSync -> do -- translate the block to a real Cardano block. void $ withAlonzoFindLeaderAndSubmitTx interpreter mockServer $ diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Reward.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Reward.hs index 792ba4c05..e26bcd49e 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Reward.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Reward.hs @@ -34,7 +34,7 @@ import Control.Monad (forM_, void) import qualified Data.Map as Map import Data.Text (Text) import Ouroboros.Network.Block (blockPoint) -import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigAndDropDB) +import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigDropDB) import Test.Cardano.Db.Mock.UnifiedApi ( fillEpochPercentage, fillEpochs, @@ -59,7 +59,7 @@ import Test.Tasty.HUnit (Assertion) simpleRewards :: IOManager -> [(Text, Text)] -> Assertion simpleRewards = - withFullConfigAndDropDB babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync void $ registerAllStakeCreds interpreter mockServer diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Simple.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Simple.hs index f405781bc..d9eefee24 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Simple.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Simple.hs @@ -14,7 +14,7 @@ import Control.Concurrent.Class.MonadSTM.Strict (atomically) import Control.Monad (void) import Data.Text (Text) import Ouroboros.Network.Block (blockNo) -import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigAndDropDB) +import Test.Cardano.Db.Mock.Config (babbageConfigDir, startDBSync, stopDBSync, withFullConfig, withFullConfigDropDB) import Test.Cardano.Db.Mock.Examples (mockBlock0, mockBlock1, mockBlock2) import Test.Cardano.Db.Mock.UnifiedApi (fillUntilNextEpoch, forgeAndSubmitBlocks, forgeNextAndSubmit) import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff) @@ -22,7 +22,7 @@ import Test.Tasty.HUnit (Assertion, assertBool) forgeBlocks :: IOManager -> [(Text, Text)] -> Assertion forgeBlocks = do - withFullConfigAndDropDB babbageConfigDir testLabel $ \interpreter _mockServer _dbSync -> do + withFullConfigDropDB babbageConfigDir testLabel $ \interpreter _mockServer _dbSync -> do _block0 <- forgeNext interpreter mockBlock0 _block1 <- forgeNext interpreter mockBlock1 block2 <- forgeNext interpreter mockBlock2 diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/CommandLineArg/EpochDisabled.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/CommandLineArg/EpochDisabled.hs index 607a72821..0466e9980 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/CommandLineArg/EpochDisabled.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/CommandLineArg/EpochDisabled.hs @@ -18,7 +18,7 @@ import Prelude () checkEpochDisabledArg :: IOManager -> [(Text, Text)] -> Assertion checkEpochDisabledArg = - withCustomConfigAndDropDB cliArgs Nothing conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cliArgs Nothing conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/JsonbInSchema.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/JsonbInSchema.hs index 330d4b7ec..2f96c1666 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/JsonbInSchema.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/JsonbInSchema.hs @@ -18,7 +18,7 @@ import Test.Tasty.HUnit (Assertion ()) configRemoveJsonbFromSchemaEnabled :: IOManager -> [(Text, Text)] -> Assertion configRemoveJsonbFromSchemaEnabled = do - withCustomConfigAndDropDB args (Just configRemoveJsonFromSchema) cfgDir testLabel $ \_interpreter _mockServer dbSync -> do + withCustomConfigDropDB args (Just configRemoveJsonFromSchema) cfgDir testLabel $ \_interpreter _mockServer dbSync -> do startDBSync dbSync threadDelay 7_000_000 assertEqQuery @@ -35,7 +35,7 @@ configRemoveJsonbFromSchemaEnabled = do configRemoveJsonbFromSchemaDisabled :: IOManager -> [(Text, Text)] -> Assertion configRemoveJsonbFromSchemaDisabled = do - withCustomConfigAndDropDB args (Just configRemoveJsonFromSchemaFalse) cfgDir testLabel $ + withCustomConfigDropDB args (Just configRemoveJsonFromSchemaFalse) cfgDir testLabel $ \_interpreter _mockServer dbSync -> do startDBSync dbSync threadDelay 7_000_000 @@ -52,7 +52,7 @@ configRemoveJsonbFromSchemaDisabled = do configJsonbInSchemaShouldRemoveThenAdd :: IOManager -> [(Text, Text)] -> Assertion configJsonbInSchemaShouldRemoveThenAdd = - withCustomConfigAndDropDB args (Just configRemoveJsonFromSchema) cfgDir testLabel $ \_interpreter _mockServer dbSyncEnv -> do + withCustomConfigDropDB args (Just configRemoveJsonFromSchema) cfgDir testLabel $ \_interpreter _mockServer dbSyncEnv -> do startDBSync dbSyncEnv threadDelay 7_000_000 assertEqQuery 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 index 2d8f723f9..71ff96fef 100644 --- 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 @@ -58,9 +58,9 @@ basicPruneWithAddress = performBasicPrune True performBasicPrune :: Bool -> IOManager -> [(Text, Text)] -> Assertion performBasicPrune useTxOutAddress = do - withCustomConfigAndDropDB args (Just $ configPruneForceTxIn useTxOutAddress) cfgDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB args (Just $ configPruneForceTxIn useTxOutAddress) cfgDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Add some blocks blks <- forgeAndSubmitBlocks interpreter mockServer 50 @@ -98,8 +98,8 @@ pruneWithSimpleRollbackWithAddress = performPruneWithSimpleRollback True performPruneWithSimpleRollback :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruneWithSimpleRollback useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do - let txOutTableType = txOutTableTypeFromConfig dbSync + withCustomConfigDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge some blocks blk0 <- forgeNext interpreter mockBlock0 blk1 <- forgeNext interpreter mockBlock1 @@ -141,9 +141,9 @@ pruneWithFullTxRollbackWithAddress = performPruneWithFullTxRollback True performPruneWithFullTxRollback :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruneWithFullTxRollback useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge a block blk0 <- forgeNextFindLeaderAndSubmit interpreter mockServer [] -- Add some transactions @@ -186,9 +186,9 @@ pruningShouldKeepSomeTxWithAddress = performPruningShouldKeepSomeTx True performPruningShouldKeepSomeTx :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruningShouldKeepSomeTx useTxOutAddress = do - withCustomConfigAndDropDB cmdLineArgs (Just $ configPrune useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configPrune useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge some blocks blk1 <- forgeAndSubmitBlocks interpreter mockServer 80 -- These two blocks/transactions will fall within the last (2 * securityParam) 20 @@ -222,10 +222,10 @@ pruneAndRollBackOneBlockWithAddress = performPruneAndRollBackOneBlock True performPruneAndRollBackOneBlock :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruneAndRollBackOneBlock useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge some blocks void $ forgeAndSubmitBlocks interpreter mockServer 98 -- These transactions will fall within the last (2 * securityParam) 20 @@ -268,10 +268,10 @@ noPruneAndRollBackWithAddress = performNoPruneAndRollBack True performNoPruneAndRollBack :: Bool -> IOManager -> [(Text, Text)] -> Assertion performNoPruneAndRollBack useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge some blocks void $ forgeAndSubmitBlocks interpreter mockServer 98 -- Add a block with transactions @@ -314,10 +314,10 @@ pruneSameBlockWithAddress = performPruneSameBlock True performPruneSameBlock :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruneSameBlock useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge some blocks void $ forgeAndSubmitBlocks interpreter mockServer 76 blk77 <- forgeNextFindLeaderAndSubmit interpreter mockServer [] @@ -357,7 +357,7 @@ noPruneSameBlockWithAddress = performNoPruneSameBlock True performNoPruneSameBlock :: Bool -> IOManager -> [(Text, Text)] -> Assertion performNoPruneSameBlock useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks @@ -382,7 +382,7 @@ performNoPruneSameBlock useTxOutAddress = void $ forgeNextFindLeaderAndSubmit interpreter mockServer [] -- Verify everything was pruned assertBlockNoBackoff dbSync 98 - assertEqQuery dbSync (DB.queryTxOutConsumedCount $ txOutTableTypeFromConfig dbSync) 0 "Unexpected TxOutConsumedByTxId after rollback" + assertEqQuery dbSync (DB.queryTxOutConsumedCount $ txOutVariantTypeFromConfig dbSync) 0 "Unexpected TxOutConsumedByTxId after rollback" where cmdLineArgs = initCommandLineArgs testLabel = "conwayConfigNoPruneSameBlock" @@ -395,7 +395,7 @@ migrateAndPruneRestartWithAddress = performMigrateAndPruneRestart True performMigrateAndPruneRestart :: Bool -> IOManager -> [(Text, Text)] -> Assertion performMigrateAndPruneRestart useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configConsume useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks @@ -424,7 +424,7 @@ pruneRestartMissingFlagWithAddress = performPruneRestartMissingFlag True performPruneRestartMissingFlag :: Bool -> IOManager -> [(Text, Text)] -> Assertion performPruneRestartMissingFlag useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configPruneForceTxIn useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks @@ -453,7 +453,7 @@ bootstrapRestartMissingFlagWithAddress = performBootstrapRestartMissingFlag True performBootstrapRestartMissingFlag :: Bool -> IOManager -> [(Text, Text)] -> Assertion performBootstrapRestartMissingFlag useTxOutAddress = - withCustomConfigAndDropDB cmdLineArgs (Just $ configBootstrap useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configBootstrap useTxOutAddress) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks @@ -476,7 +476,7 @@ performBootstrapRestartMissingFlag useTxOutAddress = populateDbRestartWithAddressConfig :: IOManager -> [(Text, Text)] -> Assertion populateDbRestartWithAddressConfig = - withCustomConfigAndDropDB cmdLineArgs (Just $ configConsume False) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB cmdLineArgs (Just $ configConsume False) conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some blocks diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs index e618f9640..ec614c9a0 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs @@ -52,7 +52,7 @@ import qualified Prelude drepDistr :: IOManager -> [(Text, Text)] -> Assertion drepDistr = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter server dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter server dbSync -> do startDBSync dbSync -- Register SPOs, DReps, and committee to vote diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/InlineAndReference.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/InlineAndReference.hs index 3a7e5b7b2..06731f3d2 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/InlineAndReference.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/InlineAndReference.hs @@ -40,7 +40,7 @@ import Prelude (head, (!!)) unlockDatumOutput :: IOManager -> [(Text, Text)] -> Assertion unlockDatumOutput = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge a block diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs index e1ac31a84..8e8beb8b6 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Other.hs @@ -110,7 +110,7 @@ configNoStakes = poolReg :: IOManager -> [(Text, Text)] -> Assertion poolReg = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge a block @@ -387,7 +387,7 @@ mkPoolDereg epochNo _ keyHash = ConwayTxCertPool (RetirePool keyHash epochNo) forkFixedEpoch :: IOManager -> [(Text, Text)] -> Assertion forkFixedEpoch = - withFullConfigAndDropDB configDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB configDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Add a Babbage tx 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 index 7ee0a13d4..48cf45b48 100644 --- 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 @@ -37,8 +37,8 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus ( import Cardano.Crypto.Hash.Class (hashToBytes) import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Hashes (extractHash) @@ -63,10 +63,10 @@ import Test.Cardano.Db.Mock.Config ( conwayConfigDir, initCommandLineArgs, startDBSync, - txOutTableTypeFromConfig, + txOutVariantTypeFromConfig, withCustomConfig, withFullConfig, - withFullConfigAndDropDB, + withFullConfigDropDB, ) import qualified Test.Cardano.Db.Mock.UnifiedApi as Api import Test.Cardano.Db.Mock.Validate @@ -78,9 +78,9 @@ import Prelude (head, tail, (!!)) ------------------------------------------------------------------------------ simpleScript :: IOManager -> [(Text, Text)] -> Assertion simpleScript = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync - let txOutTableType = txOutTableTypeFromConfig dbSync + let txOutTableType = txOutVariantTypeFromConfig dbSync -- Forge a block with stake credentials void $ Api.registerAllStakeCreds interpreter mockServer @@ -104,18 +104,18 @@ simpleScript = getOutFields txOut = case txOut of DB.CTxOutW txOut' -> - ( C.txOutAddress txOut' - , C.txOutAddressHasScript txOut' - , C.txOutValue txOut' - , C.txOutDataHash txOut' + ( VC.txOutAddress txOut' + , VC.txOutAddressHasScript txOut' + , VC.txOutValue txOut' + , VC.txOutDataHash txOut' ) DB.VTxOutW txOut' mAddress -> case mAddress of Just address -> - ( V.addressAddress address - , V.addressHasScript address - , V.txOutValue txOut' - , V.txOutDataHash txOut' + ( VA.addressAddress address + , VA.addressHasScript address + , VA.txOutValue txOut' + , VA.txOutDataHash txOut' ) Nothing -> error "conwaySimpleScript: expected an address" @@ -501,7 +501,7 @@ multipleScriptsFailedSameBlock = registrationScriptTx :: IOManager -> [(Text, Text)] -> Assertion registrationScriptTx = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge a transaction with a registration cert @@ -670,7 +670,7 @@ deregistrationsScriptTx'' = mintMultiAsset :: IOManager -> [(Text, Text)] -> Assertion mintMultiAsset = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge a block with a multi-asset script diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Reward.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Reward.hs index 2799a942e..6b9529a13 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Reward.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Reward.hs @@ -23,7 +23,7 @@ import Prelude () simpleRewards :: IOManager -> [(Text, Text)] -> Assertion simpleRewards = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge a block with stake credentials diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs index 5f1cef9c5..0a524e99b 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Rollback.hs @@ -31,7 +31,7 @@ import Prelude (last) simpleRollback :: IOManager -> [(Text, Text)] -> Assertion simpleRollback = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do -- Forge some blocks blk0 <- forgeNext interpreter mockBlock0 blk1 <- forgeNext interpreter mockBlock1 diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Simple.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Simple.hs index 3c4216265..2d4c28121 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Simple.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Simple.hs @@ -21,7 +21,7 @@ import Prelude () forgeBlocks :: IOManager -> [(Text, Text)] -> Assertion forgeBlocks = do - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter _ _ -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter _ _ -> do void $ forgeNext interpreter mockBlock0 void $ forgeNext interpreter mockBlock1 block <- forgeNext interpreter mockBlock2 diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs index d89289520..798eca6ee 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Stake.hs @@ -42,7 +42,7 @@ import Prelude () registrationTx :: IOManager -> [(Text, Text)] -> Assertion registrationTx = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge some registration txs @@ -231,7 +231,7 @@ stakeAddressPtrUseBefore = stakeDistGenesis :: IOManager -> [(Text, Text)] -> Assertion stakeDistGenesis = - withFullConfigAndDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do + withFullConfigDropDB conwayConfigDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Forge an entire epoch diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Tx.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Tx.hs index 4adeac2b3..1686693be 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Tx.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Tx.hs @@ -124,7 +124,7 @@ consumeSameBlock = addTxMetadata :: IOManager -> [(Text, Text)] -> Assertion addTxMetadata = do - withCustomConfigAndDropDB args (Just configMetadataEnable) cfgDir testLabel $ + withCustomConfigDropDB args (Just configMetadataEnable) cfgDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Add blocks with transactions @@ -145,7 +145,7 @@ addTxMetadata = do addTxMetadataWhitelist :: IOManager -> [(Text, Text)] -> Assertion addTxMetadataWhitelist = do - withCustomConfigAndDropDB args (Just configMetadataKeys) cfgDir testLabel $ \interpreter mockServer dbSync -> do + withCustomConfigDropDB args (Just configMetadataKeys) cfgDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Add blocks with transactions @@ -169,7 +169,7 @@ addTxMetadataWhitelist = do addTxMetadataDisabled :: IOManager -> [(Text, Text)] -> Assertion addTxMetadataDisabled = do - withCustomConfigAndDropDB args (Just configMetadataDisable) cfgDir testLabel $ + withCustomConfigDropDB args (Just configMetadataDisable) cfgDir testLabel $ \interpreter mockServer dbSync -> do startDBSync dbSync -- Add blocks with transactions diff --git a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs index a7647cbea..8c96d6297 100644 --- a/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs +++ b/cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs @@ -44,8 +44,8 @@ module Test.Cardano.Db.Mock.Validate ( import Cardano.Db import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Era.Shelley.Generic.Util import qualified Cardano.Ledger.Address as Ledger @@ -107,7 +107,7 @@ assertTxCount env n = do assertTxOutCount :: DBSyncEnv -> Word -> IO () assertTxOutCount env n = do - assertEqBackoff env (queryTxOutCount TxOutCore) n defaultDelays "Unexpected txOut count" + assertEqBackoff env (queryTxOutCount TxOutVariantCore) n defaultDelays "Unexpected txOut count" assertTxInCount :: DBSyncEnv -> Word -> IO () assertTxInCount env n = do @@ -138,7 +138,7 @@ expectFailSilent name action = testCase name $ do -- checking that unspent count matches from tx_in to tx_out assertUnspentTx :: DBSyncEnv -> IO () assertUnspentTx dbSyncEnv = do - let txOutTableType = txOutTableTypeFromConfig dbSyncEnv + let txOutTableType = txOutVariantTypeFromConfig dbSyncEnv unspentTxCount <- queryDBSync dbSyncEnv $ DB.queryTxOutConsumedNullCount txOutTableType consumedNullCount <- queryDBSync dbSyncEnv $ DB.queryTxOutUnspentCount txOutTableType assertEqual "Unexpected tx unspent count between tx-in & tx-out" unspentTxCount consumedNullCount @@ -216,7 +216,7 @@ assertAddrValues :: assertAddrValues env ix expected sta = do addr <- assertRight $ resolveAddress ix sta let address = Generic.renderAddress addr - q = queryAddressOutputs TxOutCore address + q = queryAddressOutputs TxOutVariantCore address assertEqBackoff env q expected defaultDelays "Unexpected Balance" assertRight :: Show err => Either err a -> IO a @@ -375,7 +375,7 @@ assertAlonzoCounts env expected = colInputs <- maybe 0 unValue . listToMaybe <$> (select . from $ \(_a :: SqlExpr (Entity CollateralTxIn)) -> pure countRows) - scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutCore + scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutVariantCore redeemerTxIn <- fromIntegral . length <$> queryTxInRedeemer invalidTx <- fromIntegral . length <$> queryInvalidTx txIninvalidTx <- fromIntegral . length <$> queryTxInFailedTx @@ -408,7 +408,7 @@ assertBabbageCounts env expected = colInputs <- maybe 0 unValue . listToMaybe <$> (select . from $ \(_a :: SqlExpr (Entity CollateralTxIn)) -> pure countRows) - scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutCore + scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutVariantCore redeemerTxIn <- fromIntegral . length <$> queryTxInRedeemer invalidTx <- fromIntegral . length <$> queryInvalidTx txIninvalidTx <- fromIntegral . length <$> queryTxInFailedTx @@ -418,29 +418,29 @@ assertBabbageCounts env expected = referenceTxIn <- maybe 0 unValue . listToMaybe <$> (select . from $ \(_a :: SqlExpr (Entity ReferenceTxIn)) -> pure countRows) - collTxOut <- case txOutTableTypeFromConfig env of - TxOutCore -> do + collTxOut <- case txOutVariantTypeFromConfig env of + TxOutVariantCore -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \(_a :: SqlExpr (Entity C.CollateralTxOut)) -> pure countRows) + <$> (select . from $ \(_a :: SqlExpr (Entity VC.CollateralTxOut)) -> pure countRows) TxOutVariantAddress -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \(_a :: SqlExpr (Entity V.CollateralTxOut)) -> pure countRows) + <$> (select . from $ \(_a :: SqlExpr (Entity VA.CollateralTxOut)) -> pure countRows) inlineDatum <- - case txOutTableTypeFromConfig env of - TxOutCore -> do + case txOutVariantTypeFromConfig env of + TxOutVariantCore -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutInlineDatumId)) >> pure countRows) + <$> (select . from $ \txOut -> where_ (isJust (txOut ^. VC.TxOutInlineDatumId)) >> pure countRows) TxOutVariantAddress -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutInlineDatumId)) >> pure countRows) + <$> (select . from $ \txOut -> where_ (isJust (txOut ^. VA.TxOutInlineDatumId)) >> pure countRows) referenceScript <- - case txOutTableTypeFromConfig env of - TxOutCore -> do + case txOutVariantTypeFromConfig env of + TxOutVariantCore -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutReferenceScriptId)) >> pure countRows) + <$> (select . from $ \txOut -> where_ (isJust (txOut ^. VC.TxOutReferenceScriptId)) >> pure countRows) TxOutVariantAddress -> do maybe 0 unValue . listToMaybe - <$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutReferenceScriptId)) >> pure countRows) + <$> (select . from $ \txOut -> where_ (isJust (txOut ^. VA.TxOutReferenceScriptId)) >> pure countRows) pure ( scripts , redeemers diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs index 4cb12e463..3d0ae2688 100644 --- a/cardano-db-sync/src/Cardano/DbSync.hs +++ b/cardano-db-sync/src/Cardano/DbSync.hs @@ -273,7 +273,7 @@ extractSyncOptions snp aop snc = , ioPoolStats = isPoolStatsEnabled (sioPoolStats (dncInsertOptions snc)) , ioGov = useGovernance , ioRemoveJsonbFromSchema = isRemoveJsonbFromSchemaEnabled (sioRemoveJsonbFromSchema (dncInsertOptions snc)) - , ioTxOutTableType = ioTxOutTableType' + , ioTxOutVariantType = ioTxOutVariantType' } useLedger = sioLedger (dncInsertOptions snc) == LedgerEnable @@ -287,7 +287,7 @@ extractSyncOptions snp aop snc = isTxOutConsumedBootstrap' = isTxOutConsumedBootstrap . sioTxOut . dncInsertOptions $ snc isTxOutEnabled' = isTxOutEnabled . sioTxOut . dncInsertOptions $ snc forceTxIn' = forceTxIn . sioTxOut . dncInsertOptions $ snc - ioTxOutTableType' = txOutConfigToTableType $ sioTxOut $ dncInsertOptions snc + ioTxOutVariantType' = txOutConfigToTableType $ sioTxOut $ dncInsertOptions snc startupReport :: Trace IO Text -> Bool -> SyncNodeParams -> IO () startupReport trce aop params = do @@ -296,10 +296,10 @@ startupReport trce aop params = do logInfo trce $ mconcat ["Enviroment variable DbSyncAbortOnPanic: ", textShow aop] logInfo trce $ textShow params -txOutConfigToTableType :: TxOutConfig -> DB.TxOutTableType +txOutConfigToTableType :: TxOutConfig -> DB.TxOutVariantType txOutConfigToTableType config = case config of - TxOutEnable (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutCore - TxOutDisable -> DB.TxOutCore - TxOutConsumed _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutCore - TxOutConsumedPrune _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutCore - TxOutConsumedBootstrap _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutCore + TxOutEnable (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutVariantCore + TxOutDisable -> DB.TxOutVariantCore + TxOutConsumed _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutVariantCore + TxOutConsumedPrune _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutVariantCore + TxOutConsumedBootstrap _ (UseTxOutAddress flag) -> if flag then DB.TxOutVariantAddress else DB.TxOutVariantCore diff --git a/cardano-db-sync/src/Cardano/DbSync/Api.hs b/cardano-db-sync/src/Cardano/DbSync/Api.hs index 4bad39673..cfb5b43eb 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api.hs @@ -24,7 +24,7 @@ module Cardano.DbSync.Api ( getPruneInterval, whenConsumeOrPruneTxOut, whenPruneTxOut, - getTxOutTableType, + getTxOutVariantType, getPruneConsume, getHasConsumedOrPruneTxOut, getSkipTxIn, @@ -116,7 +116,7 @@ getIsConsumedFixed env = (False, True) -> Just <$> DB.runDbIohkNoLogging backend (DB.queryWrongConsumedBy txOutTableType) _ -> pure Nothing where - txOutTableType = getTxOutTableType env + txOutTableType = getTxOutVariantType env pcm = soptPruneConsumeMigration $ envOptions env backend = envBackend env @@ -153,7 +153,7 @@ getPruneConsume = soptPruneConsumeMigration . envOptions runExtraMigrationsMaybe :: SyncEnv -> IO () runExtraMigrationsMaybe syncEnv = do let pcm = getPruneConsume syncEnv - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv logInfo (getTrace syncEnv) $ "runExtraMigrationsMaybe: " <> textShow pcm DB.runDbIohkNoLogging (envBackend syncEnv) $ DB.runExtraMigrations @@ -184,8 +184,8 @@ whenPruneTxOut :: MonadIO m => SyncEnv -> m () -> m () whenPruneTxOut env = when (DB.pcmPruneTxOut $ getPruneConsume env) -getTxOutTableType :: SyncEnv -> DB.TxOutTableType -getTxOutTableType syncEnv = ioTxOutTableType . soptInsertOptions $ envOptions syncEnv +getTxOutVariantType :: SyncEnv -> DB.TxOutVariantType +getTxOutVariantType syncEnv = ioTxOutVariantType . soptInsertOptions $ envOptions syncEnv getHasConsumedOrPruneTxOut :: SyncEnv -> Bool getHasConsumedOrPruneTxOut = diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs index 67893b2e6..3862d3bcc 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Ledger.hs @@ -64,7 +64,7 @@ migrateBootstrapUTxO syncEnv = do HasLedger lenv -> do liftIO $ logInfo trce "Starting UTxO bootstrap migration" cls <- liftIO $ readCurrentStateUnsafe lenv - count <- lift $ DB.deleteTxOut (getTxOutTableType syncEnv) + count <- lift $ DB.deleteTxOut (getTxOutVariantType syncEnv) when (count > 0) $ liftIO $ logWarning trce $ @@ -146,7 +146,7 @@ storePage syncEnv percQuantum (n, ls) = do let maTxOuts = concatMap (mkmaTxOuts txOutTableType) $ zip txOutIds (snd <$> txOuts) void . lift $ DB.insertManyMaTxOut maTxOuts where - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv trce = getTrace syncEnv prc = Text.pack $ showGFloat (Just 1) (max 0 $ min 100.0 (fromIntegral n * percQuantum)) "" diff --git a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs index cb10af966..449c3fa1b 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Api/Types.hs @@ -83,7 +83,7 @@ data InsertOptions = InsertOptions , ioPoolStats :: !Bool , ioGov :: !Bool , ioRemoveJsonbFromSchema :: !Bool - , ioTxOutTableType :: !DB.TxOutTableType + , ioTxOutVariantType :: !DB.TxOutVariantType } deriving (Show) diff --git a/cardano-db-sync/src/Cardano/DbSync/Cache.hs b/cardano-db-sync/src/Cardano/DbSync/Cache.hs index 4457caf2c..da1f4b987 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Cache.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Cache.hs @@ -32,7 +32,7 @@ module Cardano.DbSync.Cache ( import Cardano.BM.Trace import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache) import qualified Cardano.DbSync.Cache.FIFO as FIFO import qualified Cardano.DbSync.Cache.LRU as LRU @@ -259,8 +259,8 @@ insertAddressUsingCache :: CacheStatus -> CacheAction -> ByteString -> - V.Address -> - ReaderT SqlBackend m V.AddressId + VA.Address -> + ReaderT SqlBackend m VA.AddressId insertAddressUsingCache cache cacheUA addrRaw vAdrs = do case cache of NoCache -> do diff --git a/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs index 96307d8a3..c57265383 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs @@ -31,7 +31,7 @@ module Cardano.DbSync.Cache.Types ( ) where import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA import Cardano.DbSync.Cache.FIFO (FIFOCache) import qualified Cardano.DbSync.Cache.FIFO as FIFO import Cardano.DbSync.Cache.LRU (LRUCache) @@ -82,7 +82,7 @@ data CacheInternal = CacheInternal , cPrevBlock :: !(StrictTVar IO (Maybe (DB.BlockId, ByteString))) , cStats :: !(StrictTVar IO CacheStatistics) , cEpoch :: !(StrictTVar IO CacheEpoch) - , cAddress :: !(StrictTVar IO (LRUCache ByteString V.AddressId)) + , cAddress :: !(StrictTVar IO (LRUCache ByteString VA.AddressId)) , cTxIds :: !(StrictTVar IO (FIFOCache Ledger.TxId DB.TxId)) } diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs index 6156be9ae..c908f2f14 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Types.hs @@ -19,7 +19,7 @@ module Cardano.DbSync.Config.Types ( GenesisHashAlonzo (..), GenesisHashConway (..), RemoveJsonbFromSchemaConfig (..), - TxOutTableTypeConfig (..), + TxOutVariantTypeConfig (..), SyncNodeConfig (..), SyncPreConfig (..), SyncInsertConfig (..), @@ -69,7 +69,7 @@ import qualified Cardano.BM.Data.Configuration as Logging import qualified Cardano.Chain.Update as Byron import Cardano.Crypto (RequiresNetworkMagic (..)) import qualified Cardano.Crypto.Hash as Crypto -import Cardano.Db (MigrationDir, PGPassSource (..), TxOutTableType (..)) +import Cardano.Db (MigrationDir, PGPassSource (..), TxOutVariantType (..)) import Cardano.Prelude import Cardano.Slotting.Slot (SlotNo (..)) import Control.Monad (fail) @@ -267,8 +267,8 @@ newtype RemoveJsonbFromSchemaConfig = RemoveJsonbFromSchemaConfig } deriving (Eq, Show) -newtype TxOutTableTypeConfig = TxOutTableTypeConfig - { unTxOutTableTypeConfig :: TxOutTableType +newtype TxOutVariantTypeConfig = TxOutVariantTypeConfig + { unTxOutVariantTypeConfig :: TxOutVariantType } deriving (Eq, Show) @@ -696,14 +696,14 @@ instance FromJSON RemoveJsonbFromSchemaConfig where instance ToJSON RemoveJsonbFromSchemaConfig where toJSON = boolToEnableDisable . isRemoveJsonbFromSchemaEnabled -instance FromJSON TxOutTableTypeConfig where +instance FromJSON TxOutVariantTypeConfig where parseJSON = Aeson.withText "use_address_table" $ \v -> - case enableDisableToTxOutTableType v of - Just g -> pure (TxOutTableTypeConfig g) + case enableDisableToTxOutVariantType v of + Just g -> pure (TxOutVariantTypeConfig g) Nothing -> fail $ "unexpected use_address_table: " <> show v -instance ToJSON TxOutTableTypeConfig where - toJSON = addressTypeToEnableDisable . unTxOutTableTypeConfig +instance ToJSON TxOutVariantTypeConfig where + toJSON = addressTypeToEnableDisable . unTxOutVariantTypeConfig instance FromJSON OffchainPoolDataConfig where parseJSON = Aeson.withText "offchain_pool_data" $ \v -> @@ -806,14 +806,14 @@ disableAllInsertOptions = , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False } -addressTypeToEnableDisable :: IsString s => TxOutTableType -> s +addressTypeToEnableDisable :: IsString s => TxOutVariantType -> s addressTypeToEnableDisable TxOutVariantAddress = "enable" -addressTypeToEnableDisable TxOutCore = "disable" +addressTypeToEnableDisable TxOutVariantCore = "disable" -enableDisableToTxOutTableType :: (Eq s, IsString s) => s -> Maybe TxOutTableType -enableDisableToTxOutTableType = \case +enableDisableToTxOutVariantType :: (Eq s, IsString s) => s -> Maybe TxOutVariantType +enableDisableToTxOutVariantType = \case "enable" -> Just TxOutVariantAddress - "disable" -> Just TxOutCore + "disable" -> Just TxOutVariantCore _ -> Nothing boolToEnableDisable :: IsString s => Bool -> s diff --git a/cardano-db-sync/src/Cardano/DbSync/Default.hs b/cardano-db-sync/src/Cardano/DbSync/Default.hs index 1703a584d..7bb34e783 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Default.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Default.hs @@ -181,7 +181,7 @@ insertBlock syncEnv cblk applyRes firstAfterRollback tookSnapshot = do commitOrIndexes withinTwoMin withinHalfHour where tracer = getTrace syncEnv - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv iopts = getInsertOptions syncEnv updateEpoch details isNewEpochEvent = diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs index 493f5f4e5..74daffb1c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs @@ -17,8 +17,8 @@ import qualified Cardano.Chain.Genesis as Byron import qualified Cardano.Chain.UTxO as Byron import qualified Cardano.Crypto as Crypto import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (SyncEnv (..)) import Cardano.DbSync.Cache (insertAddressUsingCache) @@ -114,7 +114,7 @@ insertValidateGenesisDist syncEnv (NetworkName networkName) cfg = do "Initial genesis distribution populated. Hash " <> renderByteArray (configGenesisHash cfg) - supply <- lift $ DB.queryTotalSupply $ getTxOutTableType syncEnv + supply <- lift $ DB.queryTotalSupply $ getTxOutVariantType 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. @@ -161,7 +161,7 @@ validateGenesisDistribution syncEnv prunes disInOut tracer networkName cfg bid = , textShow txCount ] unless disInOut $ do - totalSupply <- lift $ DB.queryGenesisSupply $ getTxOutTableType syncEnv + totalSupply <- lift $ DB.queryGenesisSupply $ getTxOutVariantType syncEnv case DB.word64ToAda <$> configGenesisSupply cfg of Left err -> dbSyncNodeError $ "validateGenesisDistribution: " <> textShow err Right expectedSupply -> @@ -210,22 +210,22 @@ insertTxOutsByron syncEnv disInOut blkId (address, value) = do } -- unless disInOut $ - case getTxOutTableType syncEnv of - DB.TxOutCore -> + case getTxOutVariantType syncEnv of + DB.TxOutVariantCore -> void . DB.insertTxOut $ DB.CTxOutW - C.TxOut - { C.txOutTxId = txId - , C.txOutIndex = 0 - , C.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 address - , C.txOutAddressHasScript = False - , C.txOutPaymentCred = Nothing - , C.txOutStakeAddressId = Nothing - , C.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value) - , C.txOutDataHash = Nothing - , C.txOutInlineDatumId = Nothing - , C.txOutReferenceScriptId = Nothing - , C.txOutConsumedByTxId = Nothing + VC.TxOut + { VC.txOutTxId = txId + , VC.txOutIndex = 0 + , VC.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 address + , VC.txOutAddressHasScript = False + , VC.txOutPaymentCred = Nothing + , VC.txOutStakeAddressId = Nothing + , VC.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value) + , VC.txOutDataHash = Nothing + , VC.txOutInlineDatumId = Nothing + , VC.txOutReferenceScriptId = Nothing + , VC.txOutConsumedByTxId = Nothing } DB.TxOutVariantAddress -> do let addrRaw = serialize' address @@ -236,28 +236,28 @@ insertTxOutsByron syncEnv disInOut blkId (address, value) = do where cache = envCache syncEnv - mkVTxOut :: DB.TxId -> V.AddressId -> V.TxOut + mkVTxOut :: DB.TxId -> VA.AddressId -> VA.TxOut mkVTxOut txId addrDetailId = - V.TxOut - { V.txOutTxId = txId - , V.txOutIndex = 0 - , V.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value) - , V.txOutDataHash = Nothing - , V.txOutInlineDatumId = Nothing - , V.txOutReferenceScriptId = Nothing - , V.txOutAddressId = addrDetailId - , V.txOutConsumedByTxId = Nothing - , V.txOutStakeAddressId = Nothing + VA.TxOut + { VA.txOutTxId = txId + , VA.txOutIndex = 0 + , VA.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value) + , VA.txOutDataHash = Nothing + , VA.txOutInlineDatumId = Nothing + , VA.txOutReferenceScriptId = Nothing + , VA.txOutAddressId = addrDetailId + , VA.txOutConsumedByTxId = Nothing + , VA.txOutStakeAddressId = Nothing } - mkVAddress :: ByteString -> V.Address + mkVAddress :: ByteString -> VA.Address mkVAddress addrRaw = do - V.Address - { V.addressAddress = Text.decodeUtf8 $ Byron.addrToBase58 address - , V.addressRaw = addrRaw - , V.addressHasScript = False - , V.addressPaymentCred = Nothing -- Byron does not have a payment credential. - , V.addressStakeAddressId = Nothing -- Byron does not have a stake address. + VA.Address + { VA.addressAddress = Text.decodeUtf8 $ Byron.addrToBase58 address + , VA.addressRaw = addrRaw + , VA.addressHasScript = False + , VA.addressPaymentCred = Nothing -- Byron does not have a payment credential. + , VA.addressStakeAddressId = Nothing -- Byron does not have a stake address. } --------------------------------------------------------------------------------- diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs index e9934f6da..3588cbfdb 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs @@ -20,8 +20,8 @@ import qualified Cardano.Chain.Update as Byron hiding (protocolVersion) import qualified Cardano.Crypto as Crypto (serializeCborHash) import Cardano.Db (DbLovelace (..)) import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..), SyncOptions (..)) import Cardano.DbSync.Cache ( @@ -324,7 +324,7 @@ insertByronTx' syncEnv blkId tx blockIndex = do -- fees are being returned so we can sum them and put them in cache to use when updating epochs pure $ unDbLovelace $ vfFee valFee where - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv iopts = getInsertOptions syncEnv tracer :: Trace IO Text @@ -349,22 +349,22 @@ insertTxOutByron :: ReaderT SqlBackend m () insertTxOutByron syncEnv _hasConsumed bootStrap txId index txout = unless bootStrap $ - case ioTxOutTableType . soptInsertOptions $ envOptions syncEnv of - DB.TxOutCore -> do + case ioTxOutVariantType . soptInsertOptions $ envOptions syncEnv of + DB.TxOutVariantCore -> do void . DB.insertTxOut $ DB.CTxOutW $ - C.TxOut - { C.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 (Byron.txOutAddress txout) - , C.txOutAddressHasScript = False - , C.txOutDataHash = Nothing - , C.txOutConsumedByTxId = Nothing - , C.txOutIndex = fromIntegral index - , C.txOutInlineDatumId = Nothing - , C.txOutPaymentCred = Nothing -- Byron does not have a payment credential. - , C.txOutReferenceScriptId = Nothing - , C.txOutStakeAddressId = Nothing -- Byron does not have a stake address. - , C.txOutTxId = txId - , C.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout) + VC.TxOut + { VC.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 (Byron.txOutAddress txout) + , VC.txOutAddressHasScript = False + , VC.txOutDataHash = Nothing + , VC.txOutConsumedByTxId = Nothing + , VC.txOutIndex = fromIntegral index + , VC.txOutInlineDatumId = Nothing + , VC.txOutPaymentCred = Nothing -- Byron does not have a payment credential. + , VC.txOutReferenceScriptId = Nothing + , VC.txOutStakeAddressId = Nothing -- Byron does not have a stake address. + , VC.txOutTxId = txId + , VC.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout) } DB.TxOutVariantAddress -> do addrDetailId <- insertAddressUsingCache cache UpdateCache addrRaw vAddress @@ -375,28 +375,28 @@ insertTxOutByron syncEnv _hasConsumed bootStrap txId index txout = cache = envCache syncEnv - vTxOut :: V.AddressId -> V.TxOut + vTxOut :: VA.AddressId -> VA.TxOut vTxOut addrDetailId = - V.TxOut - { V.txOutAddressId = addrDetailId - , V.txOutConsumedByTxId = Nothing - , V.txOutDataHash = Nothing - , V.txOutIndex = fromIntegral index - , V.txOutInlineDatumId = Nothing - , V.txOutReferenceScriptId = Nothing - , V.txOutTxId = txId - , V.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout) - , V.txOutStakeAddressId = Nothing + VA.TxOut + { VA.txOutAddressId = addrDetailId + , VA.txOutConsumedByTxId = Nothing + , VA.txOutDataHash = Nothing + , VA.txOutIndex = fromIntegral index + , VA.txOutInlineDatumId = Nothing + , VA.txOutReferenceScriptId = Nothing + , VA.txOutTxId = txId + , VA.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout) + , VA.txOutStakeAddressId = Nothing } - vAddress :: V.Address + vAddress :: VA.Address vAddress = - V.Address - { V.addressAddress = Text.decodeUtf8 $ Byron.addrToBase58 (Byron.txOutAddress txout) - , V.addressRaw = addrRaw - , V.addressHasScript = False - , V.addressPaymentCred = Nothing -- Byron does not have a payment credential. - , V.addressStakeAddressId = Nothing -- Byron does not have a stake address. + VA.Address + { VA.addressAddress = Text.decodeUtf8 $ Byron.addrToBase58 (Byron.txOutAddress txout) + , VA.addressRaw = addrRaw + , VA.addressHasScript = False + , VA.addressPaymentCred = Nothing -- Byron does not have a payment credential. + , VA.addressStakeAddressId = Nothing -- Byron does not have a stake address. } insertTxIn :: @@ -416,7 +416,7 @@ insertTxIn _tracer txInTxId (Byron.TxInUtxo _txHash inIndex, txOutTxId, _, _) = -- ----------------------------------------------------------------------------- -resolveTxInputs :: MonadIO m => DB.TxOutTableType -> Byron.TxIn -> ExceptT SyncNodeError (ReaderT SqlBackend m) (Byron.TxIn, DB.TxId, DB.TxOutIdW, DbLovelace) +resolveTxInputs :: MonadIO m => DB.TxOutVariantType -> Byron.TxIn -> ExceptT SyncNodeError (ReaderT SqlBackend m) (Byron.TxIn, DB.TxId, DB.TxOutIdW, DbLovelace) resolveTxInputs txOutTableType txIn@(Byron.TxInUtxo txHash index) = do res <- liftLookupFail "resolveInput" $ DB.queryTxOutIdValue txOutTableType (Byron.unTxHash txHash, fromIntegral index) pure $ convert res diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs index e4a746c44..44f226699 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs @@ -13,8 +13,8 @@ module Cardano.DbSync.Era.Shelley.Genesis ( import Cardano.BM.Trace (Trace, logError, logInfo) import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..), SyncOptions (..)) import Cardano.DbSync.Cache (insertAddressUsingCache, tryUpdateCacheTx) @@ -173,7 +173,7 @@ validateGenesisDistribution :: validateGenesisDistribution syncEnv prunes networkName cfg bid expectedTxCount = runExceptT $ do let tracer = getTrace syncEnv - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv liftIO $ logInfo tracer "Validating Genesis distribution" meta <- liftLookupFail "Shelley.validateGenesisDistribution" DB.queryMeta @@ -249,22 +249,22 @@ insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do tryUpdateCacheTx (envCache syncEnv) txInId txId _ <- insertStakeAddressRefIfMissing trce useNoCache (txOut ^. Core.addrTxOutL) - case ioTxOutTableType . soptInsertOptions $ envOptions syncEnv of - DB.TxOutCore -> + case ioTxOutVariantType . soptInsertOptions $ envOptions syncEnv of + DB.TxOutVariantCore -> void . DB.insertTxOut $ DB.CTxOutW - C.TxOut - { C.txOutAddress = Generic.renderAddress addr - , C.txOutAddressHasScript = hasScript - , C.txOutDataHash = Nothing -- No output datum in Shelley Genesis - , C.txOutIndex = 0 - , C.txOutInlineDatumId = Nothing - , C.txOutPaymentCred = Generic.maybePaymentCred addr - , C.txOutReferenceScriptId = Nothing - , C.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis - , C.txOutTxId = txId - , C.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL) - , C.txOutConsumedByTxId = Nothing + VC.TxOut + { VC.txOutAddress = Generic.renderAddress addr + , VC.txOutAddressHasScript = hasScript + , VC.txOutDataHash = Nothing -- No output datum in Shelley Genesis + , VC.txOutIndex = 0 + , VC.txOutInlineDatumId = Nothing + , VC.txOutPaymentCred = Generic.maybePaymentCred addr + , VC.txOutReferenceScriptId = Nothing + , VC.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis + , VC.txOutTxId = txId + , VC.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL) + , VC.txOutConsumedByTxId = Nothing } DB.TxOutVariantAddress -> do addrDetailId <- insertAddressUsingCache cache UpdateCache addrRaw vAddress @@ -275,28 +275,28 @@ insertTxOuts syncEnv trce blkId (TxIn txInId _, txOut) = do hasScript = maybe False Generic.hasCredScript (Generic.getPaymentCred addr) addrRaw = serialiseAddr addr - makeVTxOut :: V.AddressId -> DB.TxId -> V.TxOut + makeVTxOut :: VA.AddressId -> DB.TxId -> VA.TxOut makeVTxOut addrDetailId txId = - V.TxOut - { V.txOutAddressId = addrDetailId - , V.txOutConsumedByTxId = Nothing - , V.txOutDataHash = Nothing -- No output datum in Shelley Genesis - , V.txOutIndex = 0 - , V.txOutInlineDatumId = Nothing - , V.txOutReferenceScriptId = Nothing - , V.txOutTxId = txId - , V.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL) - , V.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis + VA.TxOut + { VA.txOutAddressId = addrDetailId + , VA.txOutConsumedByTxId = Nothing + , VA.txOutDataHash = Nothing -- No output datum in Shelley Genesis + , VA.txOutIndex = 0 + , VA.txOutInlineDatumId = Nothing + , VA.txOutReferenceScriptId = Nothing + , VA.txOutTxId = txId + , VA.txOutValue = Generic.coinToDbLovelace (txOut ^. Core.valueTxOutL) + , VA.txOutStakeAddressId = Nothing -- No stake addresses in Shelley Genesis } - vAddress :: V.Address + vAddress :: VA.Address vAddress = - V.Address - { V.addressAddress = Generic.renderAddress addr - , V.addressRaw = addrRaw - , V.addressHasScript = hasScript - , V.addressPaymentCred = Generic.maybePaymentCred addr - , V.addressStakeAddressId = Nothing -- No stake addresses in Shelley Genesis + VA.Address + { VA.addressAddress = Generic.renderAddress addr + , VA.addressRaw = addrRaw + , VA.addressHasScript = hasScript + , VA.addressPaymentCred = Generic.maybePaymentCred addr + , VA.addressStakeAddressId = Nothing -- No stake addresses in Shelley Genesis } -- Insert pools and delegations coming from Genesis. diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs index 51ad9952b..852c1301c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs @@ -12,7 +12,7 @@ module Cardano.DbSync.Era.Shelley.Query ( ) where import Cardano.Db -import Cardano.DbSync.Api (getTxOutTableType) +import Cardano.DbSync.Api (getTxOutVariantType) import Cardano.DbSync.Api.Types (SyncEnv) import qualified Cardano.DbSync.Era.Shelley.Generic as Generic import Cardano.DbSync.Util @@ -21,23 +21,21 @@ import Database.Esqueleto.Experimental ( SqlBackend, ) -{- HLINT ignore "Fuse on/on" -} - resolveStakeAddress :: MonadIO m => ByteString -> ReaderT SqlBackend m (Either LookupFail StakeAddressId) resolveStakeAddress addr = queryStakeAddress addr renderByteArray resolveInputTxOutId :: MonadIO m => SyncEnv -> Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdW)) resolveInputTxOutId syncEnv txIn = - queryTxOutId (getTxOutTableType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) + queryTxOutId (getTxOutVariantType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) resolveInputValue :: MonadIO m => SyncEnv -> Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (TxId, DbLovelace)) resolveInputValue syncEnv txIn = - queryTxOutValue (getTxOutTableType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) + queryTxOutValue (getTxOutVariantType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) resolveInputTxOutIdValue :: MonadIO m => SyncEnv -> Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdW, DbLovelace)) resolveInputTxOutIdValue syncEnv txIn = - queryTxOutIdValue (getTxOutTableType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) + queryTxOutIdValue (getTxOutVariantType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) queryResolveInputCredentials :: MonadIO m => SyncEnv -> Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (Maybe ByteString, Bool)) queryResolveInputCredentials syncEnv txIn = do - queryTxOutCredentials (getTxOutTableType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) + queryTxOutCredentials (getTxOutVariantType syncEnv) (Generic.toTxHash txIn, fromIntegral (Generic.txInIndex txIn)) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/ValidateWithdrawal.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/ValidateWithdrawal.hs index 18f3da879..eca7b2fc8 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/ValidateWithdrawal.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/ValidateWithdrawal.hs @@ -42,8 +42,6 @@ import Database.Esqueleto.Experimental ( (^.), ) -{- HLINT ignore "Fuse on/on" -} - -- For any stake address which has seen a withdrawal, the sum of the withdrawals for that address -- should be less than or equal to the sum of the rewards for that address. validateRewardWithdrawals :: 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 index dc6b61234..a72334eb1 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Grouped.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Grouped.hs @@ -17,8 +17,8 @@ module Cardano.DbSync.Era.Universal.Insert.Grouped ( import Cardano.BM.Trace (Trace, logWarning) import Cardano.Db (DbLovelace (..), MinIds (..), minIdsCoreToText, minIdsVariantToText) import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (SyncEnv (..)) import Cardano.DbSync.Cache (queryTxIdWithCache) @@ -108,12 +108,12 @@ insertBlockGroupedData syncEnv grouped = do pure $ makeMinId txInIds txOutIds maTxOutIds where tracer = getTrace syncEnv - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv makeMinId :: [DB.TxInId] -> [DB.TxOutIdW] -> [DB.MaTxOutIdW] -> DB.MinIdsWrapper makeMinId txInIds txOutIds maTxOutIds = case txOutTableType of - DB.TxOutCore -> do + DB.TxOutVariantCore -> do DB.CMinIdsWrapper $ DB.MinIds { minTxInId = listToMaybe txInIds @@ -128,7 +128,7 @@ insertBlockGroupedData syncEnv grouped = do , minMaTxOutId = listToMaybe $ DB.convertMaTxOutIdVariant maTxOutIds } -mkmaTxOuts :: DB.TxOutTableType -> (DB.TxOutIdW, [MissingMaTxOut]) -> [DB.MaTxOutW] +mkmaTxOuts :: DB.TxOutVariantType -> (DB.TxOutIdW, [MissingMaTxOut]) -> [DB.MaTxOutW] mkmaTxOuts _txOutTableType (txOutId, mmtos) = mkmaTxOut <$> mmtos where mkmaTxOut :: MissingMaTxOut -> DB.MaTxOutW @@ -136,17 +136,17 @@ mkmaTxOuts _txOutTableType (txOutId, mmtos) = mkmaTxOut <$> mmtos case txOutId of DB.CTxOutIdW txOutId' -> DB.CMaTxOutW $ - C.MaTxOut - { C.maTxOutIdent = mmtoIdent missingMaTx - , C.maTxOutQuantity = mmtoQuantity missingMaTx - , C.maTxOutTxOutId = txOutId' + VC.MaTxOut + { VC.maTxOutIdent = mmtoIdent missingMaTx + , VC.maTxOutQuantity = mmtoQuantity missingMaTx + , VC.maTxOutTxOutId = txOutId' } DB.VTxOutIdW txOutId' -> DB.VMaTxOutW - V.MaTxOut - { V.maTxOutIdent = mmtoIdent missingMaTx - , V.maTxOutQuantity = mmtoQuantity missingMaTx - , V.maTxOutTxOutId = txOutId' + VA.MaTxOut + { VA.maTxOutIdent = mmtoIdent missingMaTx + , VA.maTxOutQuantity = mmtoQuantity missingMaTx + , VA.maTxOutTxOutId = txOutId' } prepareUpdates :: @@ -210,8 +210,8 @@ resolveTxInputs syncEnv hasConsumed needsValue groupedOutputs txIn = convertnotFound :: DB.TxOutW -> (Generic.TxIn, DB.TxId, Either Generic.TxIn DB.TxOutIdW, Maybe DbLovelace) convertnotFound txOutWrapper = case txOutWrapper of - DB.CTxOutW cTxOut -> (txIn, C.txOutTxId cTxOut, Left txIn, Nothing) - DB.VTxOutW vTxOut _ -> (txIn, V.txOutTxId vTxOut, Left txIn, Nothing) + DB.CTxOutW cTxOut -> (txIn, VC.txOutTxId cTxOut, Left txIn, Nothing) + DB.VTxOutW vTxOut _ -> (txIn, VA.txOutTxId vTxOut, Left txIn, Nothing) convertFoundTxOutId :: (DB.TxId, DB.TxOutIdW) -> (Generic.TxIn, DB.TxId, Either Generic.TxIn DB.TxOutIdW, Maybe DbLovelace) convertFoundTxOutId (txId, txOutId) = (txIn, txId, Right txOutId, Nothing) @@ -219,8 +219,8 @@ resolveTxInputs syncEnv hasConsumed needsValue groupedOutputs txIn = -- convertFoundValue :: (DB.TxId, DbLovelace) -> (Generic.TxIn, DB.TxId, Either Generic.TxIn DB.TxOutIdW, Maybe DbLovelace) convertFoundValue :: DB.TxOutW -> (Generic.TxIn, DB.TxId, Either Generic.TxIn DB.TxOutIdW, Maybe DbLovelace) convertFoundValue txOutWrapper = case txOutWrapper of - DB.CTxOutW cTxOut -> (txIn, C.txOutTxId cTxOut, Left txIn, Just $ C.txOutValue cTxOut) - DB.VTxOutW vTxOut _ -> (txIn, V.txOutTxId vTxOut, Left txIn, Just $ V.txOutValue vTxOut) + DB.CTxOutW cTxOut -> (txIn, VC.txOutTxId cTxOut, Left txIn, Just $ VC.txOutValue cTxOut) + DB.VTxOutW vTxOut _ -> (txIn, VA.txOutTxId vTxOut, Left txIn, Just $ VA.txOutValue vTxOut) -- (txIn, txId, Left txIn, Just lovelace) convertFoundAll :: (DB.TxId, DB.TxOutIdW, DbLovelace) -> (Generic.TxIn, DB.TxId, Either Generic.TxIn DB.TxOutIdW, Maybe DbLovelace) @@ -256,10 +256,10 @@ resolveScriptHash syncEnv groupedOutputs txIn = case resolveInMemory txIn groupedOutputs of Nothing -> pure $ Left err Just eutxo -> case etoTxOut eutxo of - DB.CTxOutW cTxOut -> pure $ Right $ C.txOutPaymentCred cTxOut + DB.CTxOutW cTxOut -> pure $ Right $ VC.txOutPaymentCred cTxOut DB.VTxOutW _ vAddress -> case vAddress of Nothing -> pure $ Left $ DB.DBTxOutVariant "resolveScriptHash: VTxOutW with Nothing address" - Just vAddr -> pure $ Right $ V.addressPaymentCred vAddr + Just vAddr -> pure $ Right $ VA.addressPaymentCred vAddr resolveInMemory :: Generic.TxIn -> [ExtendedTxOut] -> Maybe ExtendedTxOut resolveInMemory txIn = @@ -272,5 +272,5 @@ matches txIn eutxo = where getTxOutIndex :: DB.TxOutW -> Word64 getTxOutIndex txOutWrapper = case txOutWrapper of - DB.CTxOutW cTxOut -> C.txOutIndex cTxOut - DB.VTxOutW vTxOut _ -> V.txOutIndex vTxOut + DB.CTxOutW cTxOut -> VC.txOutIndex cTxOut + DB.VTxOutW vTxOut _ -> VA.txOutIndex vTxOut 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 index 48c5b7961..3c5954535 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Tx.hs @@ -16,8 +16,8 @@ module Cardano.DbSync.Era.Universal.Insert.Tx ( import Cardano.BM.Trace (Trace) import Cardano.Db (DbLovelace (..), DbWord64 (..)) import qualified Cardano.Db as DB -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbSync.Api import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..)) import Cardano.DbSync.Cache (insertAddressUsingCache, queryTxIdWithCache, tryUpdateCacheTx) @@ -224,31 +224,31 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma whenMaybe mScript $ lift . insertScript tracer txId !txOut <- - case ioTxOutTableType iopts of - DB.TxOutCore -> + case ioTxOutVariantType iopts of + DB.TxOutVariantCore -> pure $ DB.CTxOutW $ - C.TxOut - { C.txOutAddress = addrText - , C.txOutAddressHasScript = hasScript - , C.txOutConsumedByTxId = Nothing - , C.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , C.txOutIndex = index - , C.txOutInlineDatumId = mDatumId - , C.txOutPaymentCred = Generic.maybePaymentCred addr - , C.txOutReferenceScriptId = mScriptId - , C.txOutStakeAddressId = mSaId - , C.txOutTxId = txId - , C.txOutValue = Generic.coinToDbLovelace value + VC.TxOut + { VC.txOutAddress = addrText + , VC.txOutAddressHasScript = hasScript + , VC.txOutConsumedByTxId = Nothing + , VC.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , VC.txOutIndex = index + , VC.txOutInlineDatumId = mDatumId + , VC.txOutPaymentCred = Generic.maybePaymentCred addr + , VC.txOutReferenceScriptId = mScriptId + , VC.txOutStakeAddressId = mSaId + , VC.txOutTxId = txId + , VC.txOutValue = Generic.coinToDbLovelace value } DB.TxOutVariantAddress -> do let vAddress = - V.Address - { V.addressAddress = Generic.renderAddress addr - , V.addressRaw = Ledger.serialiseAddr addr - , V.addressHasScript = hasScript - , V.addressPaymentCred = Generic.maybePaymentCred addr - , V.addressStakeAddressId = mSaId + VA.Address + { VA.addressAddress = Generic.renderAddress addr + , VA.addressRaw = Ledger.serialiseAddr addr + , VA.addressHasScript = hasScript + , VA.addressPaymentCred = Generic.maybePaymentCred addr + , VA.addressStakeAddressId = mSaId } addrId <- lift $ insertAddressUsingCache cache UpdateCache (Ledger.serialiseAddr addr) vAddress pure $ @@ -257,8 +257,8 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma (Just vAddress) -- TODO: Unsure about what we should return here for eutxo let !eutxo = - case ioTxOutTableType iopts of - DB.TxOutCore -> ExtendedTxOut txHash txOut + case ioTxOutVariantType iopts of + DB.TxOutVariantCore -> ExtendedTxOut txHash txOut DB.TxOutVariantAddress -> ExtendedTxOut txHash txOut !maTxOuts <- whenFalseMempty (ioMultiAssets iopts) $ insertMaTxOuts tracer cache maMap pure (eutxo, maTxOuts) @@ -269,18 +269,18 @@ insertTxOut tracer cache iopts (txId, txHash) (Generic.TxOut index addr value ma addrText :: Text addrText = Generic.renderAddress addr - mkTxOutVariant :: Maybe DB.StakeAddressId -> V.AddressId -> Maybe DB.DatumId -> Maybe DB.ScriptId -> V.TxOut + mkTxOutVariant :: Maybe DB.StakeAddressId -> VA.AddressId -> Maybe DB.DatumId -> Maybe DB.ScriptId -> VA.TxOut mkTxOutVariant mSaId addrId mDatumId mScriptId = - V.TxOut - { V.txOutAddressId = addrId - , V.txOutConsumedByTxId = Nothing - , V.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , V.txOutIndex = index - , V.txOutInlineDatumId = mDatumId - , V.txOutReferenceScriptId = mScriptId - , V.txOutTxId = txId - , V.txOutValue = Generic.coinToDbLovelace value - , V.txOutStakeAddressId = mSaId + VA.TxOut + { VA.txOutAddressId = addrId + , VA.txOutConsumedByTxId = Nothing + , VA.txOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , VA.txOutIndex = index + , VA.txOutInlineDatumId = mDatumId + , VA.txOutReferenceScriptId = mScriptId + , VA.txOutTxId = txId + , VA.txOutValue = Generic.coinToDbLovelace value + , VA.txOutStakeAddressId = mSaId } insertTxMetadata :: @@ -411,47 +411,47 @@ insertCollateralTxOut tracer cache iopts (txId, _txHash) (Generic.TxOut index ad whenMaybe mScript $ lift . insertScript tracer txId _ <- - case ioTxOutTableType iopts of - DB.TxOutCore -> do + case ioTxOutVariantType iopts of + DB.TxOutVariantCore -> do lift . DB.insertCollateralTxOut $ DB.CCollateralTxOutW - $ C.CollateralTxOut - { C.collateralTxOutTxId = txId - , C.collateralTxOutIndex = index - , C.collateralTxOutAddress = Generic.renderAddress addr - , C.collateralTxOutAddressHasScript = hasScript - , C.collateralTxOutPaymentCred = Generic.maybePaymentCred addr - , C.collateralTxOutStakeAddressId = mSaId - , C.collateralTxOutValue = Generic.coinToDbLovelace value - , C.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , C.collateralTxOutMultiAssetsDescr = textShow maMap - , C.collateralTxOutInlineDatumId = mDatumId - , C.collateralTxOutReferenceScriptId = mScriptId + $ VC.CollateralTxOut + { VC.collateralTxOutTxId = txId + , VC.collateralTxOutIndex = index + , VC.collateralTxOutAddress = Generic.renderAddress addr + , VC.collateralTxOutAddressHasScript = hasScript + , VC.collateralTxOutPaymentCred = Generic.maybePaymentCred addr + , VC.collateralTxOutStakeAddressId = mSaId + , VC.collateralTxOutValue = Generic.coinToDbLovelace value + , VC.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , VC.collateralTxOutMultiAssetsDescr = textShow maMap + , VC.collateralTxOutInlineDatumId = mDatumId + , VC.collateralTxOutReferenceScriptId = mScriptId } DB.TxOutVariantAddress -> do let vAddress = - V.Address - { V.addressAddress = Generic.renderAddress addr - , V.addressRaw = Ledger.serialiseAddr addr - , V.addressHasScript = hasScript - , V.addressPaymentCred = Generic.maybePaymentCred addr - , V.addressStakeAddressId = mSaId + VA.Address + { VA.addressAddress = Generic.renderAddress addr + , VA.addressRaw = Ledger.serialiseAddr addr + , VA.addressHasScript = hasScript + , VA.addressPaymentCred = Generic.maybePaymentCred addr + , VA.addressStakeAddressId = mSaId } addrId <- lift $ insertAddressUsingCache cache UpdateCache (Ledger.serialiseAddr addr) vAddress lift . DB.insertCollateralTxOut $ DB.VCollateralTxOutW - $ V.CollateralTxOut - { V.collateralTxOutTxId = txId - , V.collateralTxOutIndex = index - , V.collateralTxOutAddressId = addrId - , V.collateralTxOutStakeAddressId = mSaId - , V.collateralTxOutValue = Generic.coinToDbLovelace value - , V.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt - , V.collateralTxOutMultiAssetsDescr = textShow maMap - , V.collateralTxOutInlineDatumId = mDatumId - , V.collateralTxOutReferenceScriptId = mScriptId + $ VA.CollateralTxOut + { VA.collateralTxOutTxId = txId + , VA.collateralTxOutIndex = index + , VA.collateralTxOutAddressId = addrId + , VA.collateralTxOutStakeAddressId = mSaId + , VA.collateralTxOutValue = Generic.coinToDbLovelace value + , VA.collateralTxOutDataHash = Generic.dataHashToBytes <$> Generic.getTxOutDatumHash dt + , VA.collateralTxOutMultiAssetsDescr = textShow maMap + , VA.collateralTxOutInlineDatumId = mDatumId + , VA.collateralTxOutReferenceScriptId = mScriptId } pure () where diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs index bc8435386..5d5186af3 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Universal/Validate.hs @@ -44,7 +44,6 @@ import Database.Esqueleto.Experimental ( ) import GHC.Err (error) -{- HLINT ignore "Fuse on/on" -} {- HLINT ignore "Reduce duplication" -} validateEpochRewards :: diff --git a/cardano-db-sync/src/Cardano/DbSync/OffChain/Query.hs b/cardano-db-sync/src/Cardano/DbSync/OffChain/Query.hs index ef2eb9574..be30dc3e0 100644 --- a/cardano-db-sync/src/Cardano/DbSync/OffChain/Query.hs +++ b/cardano-db-sync/src/Cardano/DbSync/OffChain/Query.hs @@ -61,8 +61,6 @@ import Database.Esqueleto.Experimental ( ) import System.Random.Shuffle (shuffleM) -{- HLINT ignore "Fuse on/on" -} - --------------------------------------------------------------------------------------------------------------------------------- -- Query OffChain VoteData --------------------------------------------------------------------------------------------------------------------------------- diff --git a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs index 9124bae6d..055885fa9 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Rollback.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Rollback.hs @@ -61,7 +61,7 @@ rollbackFromBlockNo syncEnv blkNo = do where trce = getTrace syncEnv cache = envCache syncEnv - txOutTableType = getTxOutTableType syncEnv + txOutTableType = getTxOutVariantType syncEnv prepareRollback :: SyncEnv -> CardanoPoint -> Tip CardanoBlock -> IO (Either SyncNodeError Bool) prepareRollback syncEnv point serverTip = @@ -108,7 +108,7 @@ prepareRollback syncEnv point serverTip = pure False -- For testing and debugging. -unsafeRollback :: Trace IO Text -> DB.TxOutTableType -> DB.PGConfig -> SlotNo -> IO (Either SyncNodeError ()) +unsafeRollback :: Trace IO Text -> DB.TxOutVariantType -> DB.PGConfig -> SlotNo -> IO (Either SyncNodeError ()) unsafeRollback trce txOutTableType config slotNo = do logWarning trce $ "Starting a forced rollback to slot: " <> textShow (unSlotNo slotNo) Right <$> DB.runDbNoLogging (DB.PGPassCached config) (void $ DB.deleteBlocksSlotNo trce txOutTableType slotNo True) diff --git a/cardano-db-tool/app/cardano-db-tool.hs b/cardano-db-tool/app/cardano-db-tool.hs index 66690ac2f..86165ad23 100644 --- a/cardano-db-tool/app/cardano-db-tool.hs +++ b/cardano-db-tool/app/cardano-db-tool.hs @@ -34,15 +34,15 @@ main = do -- ----------------------------------------------------------------------------- data Command - = CmdCreateMigration !MigrationDir !TxOutTableType - | CmdReport !Report !TxOutTableType - | CmdRollback !SlotNo !TxOutTableType - | CmdRunMigrations !MigrationDir !Bool !(Maybe LogFileDir) !TxOutTableType - | CmdTxOutMigration !TxOutTableType - | CmdUtxoSetAtBlock !Word64 !TxOutTableType + = CmdCreateMigration !MigrationDir !TxOutVariantType + | CmdReport !Report !TxOutVariantType + | CmdRollback !SlotNo !TxOutVariantType + | CmdRunMigrations !MigrationDir !Bool !(Maybe LogFileDir) !TxOutVariantType + | CmdTxOutMigration !TxOutVariantType + | CmdUtxoSetAtBlock !Word64 !TxOutVariantType | CmdPrepareSnapshot !PrepareSnapshotArgs - | CmdValidateDb !TxOutTableType - | CmdValidateAddressBalance !LedgerValidationParams !TxOutTableType + | CmdValidateDb !TxOutVariantType + | CmdValidateAddressBalance !LedgerValidationParams !TxOutVariantType | CmdVersion runCommand :: Command -> IO () @@ -68,14 +68,14 @@ runCommand cmd = CmdValidateAddressBalance params txOutAddressType -> runLedgerValidation params txOutAddressType CmdVersion -> runVersionCommand -runCreateMigration :: MigrationDir -> TxOutTableType -> IO () +runCreateMigration :: MigrationDir -> TxOutVariantType -> IO () runCreateMigration mdir txOutTableType = do mfp <- createMigration PGPassDefaultEnv mdir txOutTableType case mfp of Nothing -> putStrLn "No migration needed." Just fp -> putStrLn $ "New migration '" ++ fp ++ "' created." -runRollback :: SlotNo -> TxOutTableType -> IO () +runRollback :: SlotNo -> TxOutVariantType -> IO () runRollback slotNo txOutTableType = print =<< runDbNoLoggingEnv (deleteBlocksSlotNoNoTrace txOutTableType slotNo) @@ -111,7 +111,7 @@ pCommand = (Opt.progDesc "Create a database migration (only really used by devs).") , Opt.command "report" $ Opt.info - (CmdReport <$> pReport <*> pTxOutTableType) + (CmdReport <$> pReport <*> pTxOutVariantType) (Opt.progDesc "Run a report using data from the database.") , Opt.command "rollback" $ Opt.info @@ -130,7 +130,7 @@ pCommand = ) , Opt.command "tx_out-migration" $ Opt.info - (CmdTxOutMigration <$> pTxOutTableType) + (CmdTxOutMigration <$> pTxOutVariantType) ( Opt.progDesc $ mconcat [ "Runs the tx_out migration, which adds a new field" @@ -146,11 +146,11 @@ pCommand = (Opt.progDesc "Prepare to create a snapshot pair") , Opt.command "validate" $ Opt.info - (CmdValidateDb <$> pTxOutTableType) + (CmdValidateDb <$> pTxOutVariantType) (Opt.progDesc "Run validation checks against the database.") , Opt.command "validate-address-balance" $ Opt.info - (CmdValidateAddressBalance <$> pValidateLedgerParams <*> pTxOutTableType) + (CmdValidateAddressBalance <$> pValidateLedgerParams <*> pTxOutVariantType) (Opt.progDesc "Run validation checks against the database and the ledger Utxo set.") , Opt.command "version" $ Opt.info @@ -160,7 +160,7 @@ pCommand = where pCreateMigration :: Parser Command pCreateMigration = - CmdCreateMigration <$> pMigrationDir <*> pTxOutTableType + CmdCreateMigration <$> pMigrationDir <*> pTxOutVariantType pRunMigrations :: Parser Command pRunMigrations = @@ -168,7 +168,7 @@ pCommand = <$> pMigrationDir <*> pForceIndexes <*> optional pLogFileDir - <*> pTxOutTableType + <*> pTxOutVariantType pRollback :: Parser Command pRollback = @@ -177,7 +177,7 @@ pCommand = ( Opt.long "slot" <> Opt.help "The slot number to roll back to." ) - <*> pTxOutTableType + <*> pTxOutVariantType pUtxoSetAtBlock :: Parser Command pUtxoSetAtBlock = @@ -186,7 +186,7 @@ pCommand = ( Opt.long "slot-no" <> Opt.help "The SlotNo." ) - <*> pTxOutTableType + <*> pTxOutVariantType pPrepareSnapshot :: Parser Command pPrepareSnapshot = @@ -228,10 +228,10 @@ pForceIndexes = ) ) -pTxOutTableType :: Parser TxOutTableType -pTxOutTableType = +pTxOutVariantType :: Parser TxOutVariantType +pTxOutVariantType = Opt.flag - TxOutCore + TxOutVariantCore TxOutVariantAddress ( Opt.long "use-tx-out-address" <> Opt.help "Use the TxOut address variant schema" diff --git a/cardano-db-tool/src/Cardano/DbTool/Report.hs b/cardano-db-tool/src/Cardano/DbTool/Report.hs index d65eb16e8..2145fc3c3 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report.hs @@ -4,7 +4,7 @@ module Cardano.DbTool.Report ( runReport, ) where -import Cardano.Db (TxOutTableType) +import Cardano.Db (TxOutVariantType) import Cardano.DbTool.Report.Balance (reportBalance) import Cardano.DbTool.Report.StakeReward ( reportEpochStakeRewards, @@ -23,7 +23,7 @@ data Report | ReportLatestRewards [Text] | ReportTransactions [Text] -runReport :: Report -> TxOutTableType -> IO () +runReport :: Report -> TxOutVariantType -> IO () runReport report txOutTableType = do assertFullySynced case report of diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs b/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs index dddf08dde..36783b6b9 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs @@ -7,8 +7,8 @@ module Cardano.DbTool.Report.Balance ( ) where import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbTool.Report.Display import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Reader (ReaderT) @@ -38,9 +38,8 @@ import Database.Esqueleto.Experimental ( ) {- HLINT ignore "Redundant ^." -} -{- HLINT ignore "Fuse on/on" -} -reportBalance :: TxOutTableType -> [Text] -> IO () +reportBalance :: TxOutVariantType -> [Text] -> IO () reportBalance txOutTableType saddr = do xs <- catMaybes <$> runDbNoLoggingEnv (mapM (queryStakeAddressBalance txOutTableType) saddr) renderBalances xs @@ -59,7 +58,7 @@ data Balance = Balance , balTotal :: !Ada } -queryStakeAddressBalance :: MonadIO m => TxOutTableType -> Text -> ReaderT SqlBackend m (Maybe Balance) +queryStakeAddressBalance :: MonadIO m => TxOutVariantType -> Text -> ReaderT SqlBackend m (Maybe Balance) queryStakeAddressBalance txOutTableType address = do mSaId <- queryStakeAddressId case mSaId of @@ -95,21 +94,21 @@ queryStakeAddressBalance txOutTableType address = do queryInputs :: MonadIO m => StakeAddressId -> ReaderT SqlBackend m Ada queryInputs saId = case txOutTableType of - TxOutCore -> do + TxOutVariantCore -> do res <- select $ do - txo <- from $ table @C.TxOut - where_ (txo ^. C.TxOutStakeAddressId ==. just (val saId)) - pure (sum_ (txo ^. C.TxOutValue)) + txo <- from $ table @VC.TxOut + where_ (txo ^. VC.TxOutStakeAddressId ==. just (val saId)) + pure (sum_ (txo ^. VC.TxOutValue)) pure $ unValueSumAda (listToMaybe res) TxOutVariantAddress -> do res <- select $ do (txo :& addr) <- from $ - table @V.TxOut - `innerJoin` table @V.Address - `on` (\(txo :& addr) -> txo ^. V.TxOutAddressId ==. addr ^. V.AddressId) - where_ (addr ^. V.AddressStakeAddressId ==. just (val saId)) - pure (sum_ (txo ^. V.TxOutValue)) + table @VA.TxOut + `innerJoin` table @VA.Address + `on` (\(txo :& addr) -> txo ^. VA.TxOutAddressId ==. addr ^. VA.AddressId) + where_ (addr ^. VA.AddressStakeAddressId ==. just (val saId)) + pure (sum_ (txo ^. VA.TxOutValue)) pure $ unValueSumAda (listToMaybe res) queryRewardsSum :: MonadIO m => StakeAddressId -> ReaderT SqlBackend m Ada @@ -132,31 +131,31 @@ queryStakeAddressBalance txOutTableType address = do queryOutputs :: MonadIO m => StakeAddressId -> ReaderT SqlBackend m (Ada, Ada, Ada) queryOutputs saId = case txOutTableType of - TxOutCore -> do + TxOutVariantCore -> do res <- select $ do (txOut :& tx :& _txIn) <- from $ - table @C.TxOut + table @VC.TxOut `innerJoin` table @Tx - `on` (\(txOut :& tx) -> txOut ^. C.TxOutTxId ==. tx ^. TxId) + `on` (\(txOut :& tx) -> txOut ^. VC.TxOutTxId ==. tx ^. TxId) `innerJoin` table @TxIn - `on` (\(txOut :& tx :& txIn) -> txIn ^. TxInTxOutId ==. tx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. C.TxOutIndex) - where_ (txOut ^. C.TxOutStakeAddressId ==. just (val saId)) - pure (sum_ (txOut ^. C.TxOutValue), sum_ (tx ^. TxFee), sum_ (tx ^. TxDeposit)) + `on` (\(txOut :& tx :& txIn) -> txIn ^. TxInTxOutId ==. tx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. VC.TxOutIndex) + where_ (txOut ^. VC.TxOutStakeAddressId ==. just (val saId)) + pure (sum_ (txOut ^. VC.TxOutValue), sum_ (tx ^. TxFee), sum_ (tx ^. TxDeposit)) pure $ maybe (0, 0, 0) convert (listToMaybe res) TxOutVariantAddress -> do res <- select $ do (txOut :& addr :& tx :& _txIn) <- from $ - table @V.TxOut - `innerJoin` table @V.Address - `on` (\(txOut :& addr) -> txOut ^. V.TxOutAddressId ==. addr ^. V.AddressId) + table @VA.TxOut + `innerJoin` table @VA.Address + `on` (\(txOut :& addr) -> txOut ^. VA.TxOutAddressId ==. addr ^. VA.AddressId) `innerJoin` table @Tx - `on` (\(txOut :& _addr :& tx) -> txOut ^. V.TxOutTxId ==. tx ^. TxId) + `on` (\(txOut :& _addr :& tx) -> txOut ^. VA.TxOutTxId ==. tx ^. TxId) `innerJoin` table @TxIn - `on` (\(txOut :& _addr :& tx :& txIn) -> txIn ^. TxInTxOutId ==. tx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. V.TxOutIndex) - where_ (addr ^. V.AddressStakeAddressId ==. just (val saId)) - pure (sum_ (txOut ^. V.TxOutValue), sum_ (tx ^. TxFee), sum_ (tx ^. TxDeposit)) + `on` (\(txOut :& _addr :& tx :& txIn) -> txIn ^. TxInTxOutId ==. tx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. VA.TxOutIndex) + where_ (addr ^. VA.AddressStakeAddressId ==. just (val saId)) + pure (sum_ (txOut ^. VA.TxOutValue), sum_ (tx ^. TxFee), sum_ (tx ^. TxDeposit)) pure $ maybe (0, 0, 0) convert (listToMaybe res) convert :: (Value (Maybe Micro), Value (Maybe Micro), Value (Maybe Micro)) -> (Ada, Ada, Ada) diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs index 855c37daa..e2994ef3d 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/History.hs @@ -40,8 +40,6 @@ import Database.Esqueleto.Experimental ( ) import Text.Printf (printf) -{- HLINT ignore "Fuse on/on" -} - reportStakeRewardHistory :: Text -> IO () reportStakeRewardHistory saddr = do xs <- runDbNoLoggingEnv (queryHistoryStakeRewards saddr) diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs index c5789e32a..f7bdf05aa 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/StakeReward/Latest.hs @@ -44,8 +44,6 @@ import Database.Esqueleto.Experimental ( ) import Text.Printf (printf) -{- HLINT ignore "Fuse on/on" -} - reportEpochStakeRewards :: Word64 -> [Text] -> IO () reportEpochStakeRewards epochNum saddr = do xs <- catMaybes <$> runDbNoLoggingEnv (mapM (queryEpochStakeRewards epochNum) saddr) diff --git a/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs b/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs index fa9fc14cd..35dd44cd7 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Report/Transactions.hs @@ -17,8 +17,8 @@ module Cardano.DbTool.Report.Transactions ( ) where import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbTool.Report.Display import Cardano.Prelude (textShow) import Control.Monad (forM_) @@ -51,9 +51,8 @@ import Database.Esqueleto.Experimental ( ) {- HLINT ignore "Redundant ^." -} -{- HLINT ignore "Fuse on/on" -} -reportTransactions :: TxOutTableType -> [Text] -> IO () +reportTransactions :: TxOutVariantType -> [Text] -> IO () reportTransactions txOutTableType addrs = forM_ addrs $ \saddr -> do Text.putStrLn $ "\nTransactions for: " <> saddr <> "\n" @@ -85,7 +84,7 @@ instance Ord Transaction where GT -> GT EQ -> compare (trDirection tra) (trDirection trb) -queryStakeAddressTransactions :: MonadIO m => TxOutTableType -> Text -> ReaderT SqlBackend m [Transaction] +queryStakeAddressTransactions :: MonadIO m => TxOutVariantType -> Text -> ReaderT SqlBackend m [Transaction] queryStakeAddressTransactions txOutTableType address = do mSaId <- queryStakeAddressId case mSaId of @@ -108,36 +107,36 @@ queryStakeAddressTransactions txOutTableType address = do queryInputs :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> StakeAddressId -> ReaderT SqlBackend m [Transaction] queryInputs txOutTableType saId = do -- Standard UTxO inputs. res1 <- case txOutTableType of -- get the StakeAddressId from the Core TxOut table - TxOutCore -> select $ do + TxOutVariantCore -> select $ do (tx :& txOut :& blk) <- from $ table @Tx - `innerJoin` table @C.TxOut - `on` (\(tx :& txOut) -> txOut ^. C.TxOutTxId ==. tx ^. TxId) + `innerJoin` table @VC.TxOut + `on` (\(tx :& txOut) -> txOut ^. VC.TxOutTxId ==. tx ^. TxId) `innerJoin` table @Block `on` (\(tx :& _txOut :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId) - where_ (txOut ^. C.TxOutStakeAddressId ==. just (val saId)) - pure (tx ^. TxHash, blk ^. BlockTime, txOut ^. C.TxOutValue) + where_ (txOut ^. VC.TxOutStakeAddressId ==. just (val saId)) + pure (tx ^. TxHash, blk ^. BlockTime, txOut ^. VC.TxOutValue) -- get the StakeAddressId from the Variant TxOut table TxOutVariantAddress -> select $ do (tx :& txOut :& addr :& blk) <- from $ table @Tx - `innerJoin` table @V.TxOut - `on` (\(tx :& txOut) -> txOut ^. V.TxOutTxId ==. tx ^. TxId) - `innerJoin` table @V.Address - `on` (\(_tx :& txOut :& addr) -> txOut ^. V.TxOutAddressId ==. addr ^. V.AddressId) + `innerJoin` table @VA.TxOut + `on` (\(tx :& txOut) -> txOut ^. VA.TxOutTxId ==. tx ^. TxId) + `innerJoin` table @VA.Address + `on` (\(_tx :& txOut :& addr) -> txOut ^. VA.TxOutAddressId ==. addr ^. VA.AddressId) `innerJoin` table @Block `on` (\(tx :& _txOut :& _addr :& blk) -> tx ^. TxBlockId ==. blk ^. BlockId) - where_ (addr ^. V.AddressStakeAddressId ==. just (val saId)) - pure (tx ^. TxHash, blk ^. BlockTime, txOut ^. V.TxOutValue) + where_ (addr ^. VA.AddressStakeAddressId ==. just (val saId)) + pure (tx ^. TxHash, blk ^. BlockTime, txOut ^. VA.TxOutValue) -- Reward withdrawals. res2 <- select $ do (tx :& blk :& wdrl) <- @@ -177,41 +176,41 @@ sumAmounts = Incoming -> acc + trAmount tr Outgoing -> acc - trAmount tr -queryOutputs :: MonadIO m => TxOutTableType -> StakeAddressId -> ReaderT SqlBackend m [Transaction] +queryOutputs :: MonadIO m => TxOutVariantType -> StakeAddressId -> ReaderT SqlBackend m [Transaction] queryOutputs txOutTableType saId = do res <- case txOutTableType of - TxOutCore -> select $ do + TxOutVariantCore -> select $ do (txOut :& _txInTx :& _txIn :& txOutTx :& blk) <- from $ - table @C.TxOut + table @VC.TxOut `innerJoin` table @Tx - `on` (\(txOut :& txInTx) -> txOut ^. C.TxOutTxId ==. txInTx ^. TxId) + `on` (\(txOut :& txInTx) -> txOut ^. VC.TxOutTxId ==. txInTx ^. TxId) `innerJoin` table @TxIn - `on` (\(txOut :& txInTx :& txIn) -> txIn ^. TxInTxOutId ==. txInTx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. C.TxOutIndex) + `on` (\(txOut :& txInTx :& txIn) -> txIn ^. TxInTxOutId ==. txInTx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. VC.TxOutIndex) `innerJoin` table @Tx `on` (\(_txOut :& _txInTx :& txIn :& txOutTx) -> txOutTx ^. TxId ==. txIn ^. TxInTxInId) `innerJoin` table @Block `on` (\(_txOut :& _txInTx :& _txIn :& txOutTx :& blk) -> txOutTx ^. TxBlockId ==. blk ^. BlockId) - where_ (txOut ^. C.TxOutStakeAddressId ==. just (val saId)) - pure (txOutTx ^. TxHash, blk ^. BlockTime, txOut ^. C.TxOutValue) + where_ (txOut ^. VC.TxOutStakeAddressId ==. just (val saId)) + pure (txOutTx ^. TxHash, blk ^. BlockTime, txOut ^. VC.TxOutValue) TxOutVariantAddress -> select $ do (txOut :& addr :& _txInTx :& _txIn :& txOutTx :& blk) <- from $ - table @V.TxOut - `innerJoin` table @V.Address - `on` (\(txOut :& addr) -> txOut ^. V.TxOutAddressId ==. addr ^. V.AddressId) + table @VA.TxOut + `innerJoin` table @VA.Address + `on` (\(txOut :& addr) -> txOut ^. VA.TxOutAddressId ==. addr ^. VA.AddressId) `innerJoin` table @Tx - `on` (\(txOut :& _addr :& txInTx) -> txOut ^. V.TxOutTxId ==. txInTx ^. TxId) + `on` (\(txOut :& _addr :& txInTx) -> txOut ^. VA.TxOutTxId ==. txInTx ^. TxId) `innerJoin` table @TxIn - `on` (\(txOut :& _addr :& txInTx :& txIn) -> txIn ^. TxInTxOutId ==. txInTx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. V.TxOutIndex) + `on` (\(txOut :& _addr :& txInTx :& txIn) -> txIn ^. TxInTxOutId ==. txInTx ^. TxId &&. txIn ^. TxInTxOutIndex ==. txOut ^. VA.TxOutIndex) `innerJoin` table @Tx `on` (\(_txOut :& _addr :& _txInTx :& txIn :& txOutTx) -> txOutTx ^. TxId ==. txIn ^. TxInTxInId) `innerJoin` table @Block `on` (\(_txOut :& _addr :& _txInTx :& _txIn :& txOutTx :& blk) -> txOutTx ^. TxBlockId ==. blk ^. BlockId) - where_ (addr ^. V.AddressStakeAddressId ==. just (val saId)) - pure (txOutTx ^. TxHash, blk ^. BlockTime, txOut ^. V.TxOutValue) + where_ (addr ^. VA.AddressStakeAddressId ==. just (val saId)) + pure (txOutTx ^. TxHash, blk ^. BlockTime, txOut ^. VA.TxOutValue) pure . groupOutputs $ map (convertTx Outgoing) res where diff --git a/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs b/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs index 0f1db6346..2bd36f8a7 100644 --- a/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs +++ b/cardano-db-tool/src/Cardano/DbTool/UtxoSet.hs @@ -7,8 +7,8 @@ module Cardano.DbTool.UtxoSet ( import Cardano.Chain.Common (decodeAddressBase58, isRedeemAddress) import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Prelude (textShow) import qualified Data.List as List import qualified Data.Map.Strict as Map @@ -20,7 +20,7 @@ import Data.Word (Word64) import System.Exit (exitSuccess) import System.IO (IOMode (..), withFile) -utxoSetAtSlot :: TxOutTableType -> Word64 -> IO () +utxoSetAtSlot :: TxOutVariantType -> Word64 -> IO () utxoSetAtSlot txOutTableType slotNo = do (genesisSupply, utxoSet, fees, eUtcTime) <- queryAtSlot txOutTableType slotNo @@ -82,7 +82,7 @@ partitionUtxos = accept (addr, _) = Text.length addr <= 180 && not (isRedeemTextAddress addr) -queryAtSlot :: TxOutTableType -> Word64 -> IO (Ada, [UtxoQueryResult], Ada, Either LookupFail UTCTime) +queryAtSlot :: TxOutVariantType -> Word64 -> IO (Ada, [UtxoQueryResult], Ada, Either LookupFail UTCTime) queryAtSlot txOutTableType slotNo = -- Run the following queries in a single transaction. runDbNoLoggingEnv $ do @@ -118,8 +118,8 @@ utxoSetSum xs = getTxOutValue :: TxOutW -> Word64 getTxOutValue wrapper = case wrapper of - CTxOutW txOut -> unDbLovelace $ C.txOutValue txOut - VTxOutW txOut _ -> unDbLovelace $ V.txOutValue txOut + CTxOutW txOut -> unDbLovelace $ VC.txOutValue txOut + VTxOutW txOut _ -> unDbLovelace $ VA.txOutValue txOut writeUtxos :: FilePath -> [(Text, Word64)] -> IO () writeUtxos fname xs = do diff --git a/cardano-db-tool/src/Cardano/DbTool/Validate/Ledger.hs b/cardano-db-tool/src/Cardano/DbTool/Validate/Ledger.hs index 0572e5fdb..b1f22cfeb 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Validate/Ledger.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Validate/Ledger.hs @@ -29,7 +29,7 @@ data LedgerValidationParams = LedgerValidationParams , vpAddressUtxo :: !Text } -validateLedger :: LedgerValidationParams -> DB.TxOutTableType -> IO () +validateLedger :: LedgerValidationParams -> DB.TxOutVariantType -> IO () validateLedger params txOutTableType = withIOManager $ \_ -> do enc <- readSyncNodeConfig (vpConfigFile params) @@ -38,7 +38,7 @@ validateLedger params txOutTableType = slotNo <- SlotNo <$> DB.runDbNoLoggingEnv DB.queryLatestSlotNo validate params txOutTableType genCfg slotNo ledgerFiles -validate :: LedgerValidationParams -> DB.TxOutTableType -> GenesisConfig -> SlotNo -> [LedgerStateFile] -> IO () +validate :: LedgerValidationParams -> DB.TxOutVariantType -> GenesisConfig -> SlotNo -> [LedgerStateFile] -> IO () validate params txOutTableType genCfg slotNo ledgerFiles = go ledgerFiles True where @@ -55,7 +55,7 @@ validate params txOutTableType genCfg slotNo ledgerFiles = when logFailure . putStrLn $ redText "Ledger is newer than DB. Trying an older ledger." go rest False -validateBalance :: DB.TxOutTableType -> SlotNo -> Text -> CardanoLedgerState -> IO () +validateBalance :: DB.TxOutVariantType -> SlotNo -> Text -> CardanoLedgerState -> IO () validateBalance txOutTableType slotNo addr st = do balanceDB <- DB.runDbNoLoggingEnv $ DB.queryAddressBalanceAtSlot txOutTableType addr (unSlotNo slotNo) let eiBalanceLedger = DB.word64ToAda <$> ledgerAddrBalance addr (ledgerState $ clsState st) diff --git a/cardano-db-tool/src/Cardano/DbTool/Validate/TotalSupply.hs b/cardano-db-tool/src/Cardano/DbTool/Validate/TotalSupply.hs index b466587b6..3921bd42f 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Validate/TotalSupply.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Validate/TotalSupply.hs @@ -22,7 +22,7 @@ data TestParams = TestParams , genesisSupply :: Ada } -genTestParameters :: TxOutTableType -> IO TestParams +genTestParameters :: TxOutVariantType -> IO TestParams genTestParameters txOutTableType = do mlatest <- runDbNoLoggingEnv queryLatestBlockNo case mlatest of @@ -32,7 +32,7 @@ genTestParameters txOutTableType = do <$> randomRIO (1, latest - 1) <*> runDbNoLoggingEnv (queryGenesisSupply txOutTableType) -queryInitialSupply :: TxOutTableType -> Word64 -> IO Accounting +queryInitialSupply :: TxOutVariantType -> Word64 -> IO Accounting queryInitialSupply txOutTableType blkNo = -- Run all queries in a single transaction. runDbNoLoggingEnv $ @@ -44,7 +44,7 @@ queryInitialSupply txOutTableType blkNo = -- | Validate that the total supply is decreasing. -- This is only true for the Byron error where transaction fees are burnt. -validateTotalSupplyDecreasing :: TxOutTableType -> IO () +validateTotalSupplyDecreasing :: TxOutVariantType -> IO () validateTotalSupplyDecreasing txOutTableType = do test <- genTestParameters txOutTableType diff --git a/cardano-db-tool/src/Cardano/DbTool/Validate/TxAccounting.hs b/cardano-db-tool/src/Cardano/DbTool/Validate/TxAccounting.hs index 3c9606f2f..9cb66ce01 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Validate/TxAccounting.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Validate/TxAccounting.hs @@ -11,8 +11,8 @@ module Cardano.DbTool.Validate.TxAccounting ( ) where import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.DbTool.Validate.Util import Control.Monad (replicateM, when) import Control.Monad.IO.Class (MonadIO, liftIO) @@ -43,10 +43,8 @@ import Database.Esqueleto.Experimental ( ) import qualified System.Random as Random -{- HLINT ignore "Fuse on/on" -} - -validateTxAccounting :: TxOutTableType -> IO () -validateTxAccounting getTxOutTableType = do +validateTxAccounting :: TxOutVariantType -> IO () +validateTxAccounting getTxOutVariantType = do txIdRange <- runDbNoLoggingEnv queryTestTxIds putStrF $ "For " @@ -55,7 +53,7 @@ validateTxAccounting getTxOutTableType = do ++ show (snd txIdRange) ++ " accounting is: " ids <- randomTxIds testCount txIdRange - res <- runExceptT $ traverse (validateAccounting getTxOutTableType) ids + res <- runExceptT $ traverse (validateAccounting getTxOutVariantType) ids case res of Left err -> error $ redText (reportError err) Right _ -> putStrLn $ greenText "ok" @@ -113,11 +111,11 @@ showTxOut txo = ] where (txId, value) = case txo of - CTxOutW cTxOut -> (C.txOutTxId cTxOut, C.txOutValue cTxOut) - VTxOutW vTxOut _ -> (V.txOutTxId vTxOut, V.txOutValue vTxOut) + CTxOutW cTxOut -> (VC.txOutTxId cTxOut, VC.txOutValue cTxOut) + VTxOutW vTxOut _ -> (VA.txOutTxId vTxOut, VA.txOutValue vTxOut) -- For a given TxId, validate the input/output accounting. -validateAccounting :: TxOutTableType -> Word64 -> ExceptT ValidateError IO () +validateAccounting :: TxOutVariantType -> Word64 -> ExceptT ValidateError IO () validateAccounting txOutTableType txId = do (fee, deposit) <- liftIO $ runDbNoLoggingEnv (queryTxFeeDeposit txId) withdrawal <- liftIO $ runDbNoLoggingEnv (queryTxWithdrawal txId) @@ -140,8 +138,8 @@ sumValues = word64ToAda . sum . map txOutValue where txOutValue = unDbLovelace . \case - CTxOutW cTxOut -> C.txOutValue cTxOut - VTxOutW vTxOut _ -> V.txOutValue vTxOut + CTxOutW cTxOut -> VC.txOutValue cTxOut + VTxOutW vTxOut _ -> VA.txOutValue vTxOut -- ------------------------------------------------------------------------------------------------- @@ -167,9 +165,9 @@ queryTxFeeDeposit txId = do convert :: (Value DbLovelace, Value (Maybe Int64)) -> (Ada, Int64) convert (Value (DbLovelace w64), d) = (word64ToAda w64, fromMaybe 0 (unValue d)) -queryTxInputs :: MonadIO m => TxOutTableType -> Word64 -> ReaderT SqlBackend m [TxOutW] +queryTxInputs :: MonadIO m => TxOutVariantType -> Word64 -> ReaderT SqlBackend m [TxOutW] queryTxInputs txOutTableType txId = case txOutTableType of - TxOutCore -> map CTxOutW <$> queryInputsBody @'TxOutCore txId + TxOutVariantCore -> map CTxOutW <$> queryInputsBody @'TxOutVariantCore txId TxOutVariantAddress -> map (`VTxOutW` Nothing) <$> queryInputsBody @'TxOutVariantAddress txId queryInputsBody :: forall a m. (MonadIO m, TxOutFields a) => Word64 -> ReaderT SqlBackend m [TxOutTable a] @@ -187,9 +185,9 @@ queryInputsBody txId = do pure txout pure $ entityVal <$> res -queryTxOutputs :: MonadIO m => TxOutTableType -> Word64 -> ReaderT SqlBackend m [TxOutW] +queryTxOutputs :: MonadIO m => TxOutVariantType -> Word64 -> ReaderT SqlBackend m [TxOutW] queryTxOutputs txOutTableType txId = case txOutTableType of - TxOutCore -> map CTxOutW <$> queryTxOutputsBody @'TxOutCore txId + TxOutVariantCore -> map CTxOutW <$> queryTxOutputsBody @'TxOutVariantCore txId TxOutVariantAddress -> map (`VTxOutW` Nothing) <$> queryTxOutputsBody @'TxOutVariantAddress txId queryTxOutputsBody :: forall a m. (MonadIO m, TxOutFields a) => Word64 -> ReaderT SqlBackend m [TxOutTable a] diff --git a/cardano-db-tool/src/Cardano/DbTool/Validation.hs b/cardano-db-tool/src/Cardano/DbTool/Validation.hs index 78d23a01b..2d9d471ad 100644 --- a/cardano-db-tool/src/Cardano/DbTool/Validation.hs +++ b/cardano-db-tool/src/Cardano/DbTool/Validation.hs @@ -4,7 +4,7 @@ module Cardano.DbTool.Validation ( runLedgerValidation, ) where -import Cardano.Db (TxOutTableType) +import Cardano.Db (TxOutVariantType) import Cardano.DbTool.Validate.AdaPots (validateSumAdaPots) import Cardano.DbTool.Validate.BlockProperties (validateBlockProperties) import Cardano.DbTool.Validate.BlockTxs (validateEpochBlockTxs) @@ -15,12 +15,12 @@ import Cardano.DbTool.Validate.TotalSupply (validateTotalSupplyDecreasing) import Cardano.DbTool.Validate.TxAccounting (validateTxAccounting) import Cardano.DbTool.Validate.Withdrawal (validateWithdrawals) -runDbValidation :: TxOutTableType -> IO () +runDbValidation :: TxOutVariantType -> IO () runDbValidation txOutTableType = do fastValidations slowValidations txOutTableType -runLedgerValidation :: LedgerValidationParams -> TxOutTableType -> IO () +runLedgerValidation :: LedgerValidationParams -> TxOutVariantType -> IO () runLedgerValidation = validateLedger @@ -32,7 +32,7 @@ fastValidations = do validateBlockProperties validateSumAdaPots -slowValidations :: TxOutTableType -> IO () +slowValidations :: TxOutVariantType -> IO () slowValidations txOutTableType = do validateTxAccounting txOutTableType validateWithdrawals diff --git a/cardano-db/app/gen-schema-docs.hs b/cardano-db/app/gen-schema-docs.hs index 3f9cd7bd0..58d155aca 100644 --- a/cardano-db/app/gen-schema-docs.hs +++ b/cardano-db/app/gen-schema-docs.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} import Cardano.Db (schemaDocs) -import Cardano.Db.Schema.Core.TxOut (schemaDocsTxOutCore) -import Cardano.Db.Schema.Variant.TxOut (schemaDocsTxOutVariant) +import Cardano.Db.Schema.Variants.TxOutAddress (schemaDocsTxOutVariant) +import Cardano.Db.Schema.Variants.TxOutCore (schemaDocsTxOutVariantCore) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text @@ -72,7 +72,7 @@ docBody :: Text docBody = do coreDocBody <> variantDivider <> variantDocBody where - coreDocBody = cleanUp $ render markdownTableRenderer (schemaDocs <> schemaDocsTxOutCore) + coreDocBody = cleanUp $ render markdownTableRenderer (schemaDocs <> schemaDocsTxOutVariantCore) variantDocBody = cleanUp $ render markdownTableRenderer schemaDocsTxOutVariant cleanUp = Text.replace "ID:" "Id:" . Text.replace "#" "###" variantDivider = diff --git a/cardano-db/cardano-db.cabal b/cardano-db/cardano-db.cabal index d8afa1a33..3f1192a1f 100644 --- a/cardano-db/cardano-db.cabal +++ b/cardano-db/cardano-db.cabal @@ -30,8 +30,8 @@ library -Wunused-packages exposed-modules: Cardano.Db - Cardano.Db.Schema.Core.TxOut - Cardano.Db.Schema.Variant.TxOut + Cardano.Db.Schema.Variants.TxOutCore + Cardano.Db.Schema.Variants.TxOutAddress other-modules: Cardano.Db.Error Cardano.Db.Git.RevFromGit diff --git a/cardano-db/src/Cardano/Db/Migration.hs b/cardano-db/src/Cardano/Db/Migration.hs index 8e5d52ffd..32266b72a 100644 --- a/cardano-db/src/Cardano/Db/Migration.hs +++ b/cardano-db/src/Cardano/Db/Migration.hs @@ -29,12 +29,12 @@ import Cardano.Crypto.Hash (Blake2b_256, ByteString, Hash, hashToStringAsHex, ha import Cardano.Db.Migration.Haskell import Cardano.Db.Migration.Version import Cardano.Db.Operations.Query -import Cardano.Db.Operations.Types (TxOutTableType (..)) +import Cardano.Db.Operations.Types (TxOutVariantType (..)) import Cardano.Db.PGConfig import Cardano.Db.Run import Cardano.Db.Schema.BaseSchema -import Cardano.Db.Schema.Core.TxOut (migrateCoreTxOutCardanoDb) -import Cardano.Db.Schema.Variant.TxOut (migrateVariantAddressCardanoDb) +import Cardano.Db.Schema.Variants.TxOutAddress (migrateVariantAddressCardanoDb) +import Cardano.Db.Schema.Variants.TxOutCore (migrateCoreTxOutCardanoDb) import Cardano.Prelude (textShow) import Control.Exception (Exception, SomeException, handle) import Control.Monad.Extra @@ -106,7 +106,7 @@ data MigrationToRun = Initial | Full | Indexes -- | Run the migrations in the provided 'MigrationDir' and write date stamped log file -- to 'LogFileDir'. It returns a list of file names of all non-official schema migration files. -runMigrations :: PGConfig -> Bool -> MigrationDir -> Maybe LogFileDir -> MigrationToRun -> TxOutTableType -> IO (Bool, [FilePath]) +runMigrations :: PGConfig -> Bool -> MigrationDir -> Maybe LogFileDir -> MigrationToRun -> TxOutVariantType -> IO (Bool, [FilePath]) runMigrations pgconfig quiet migrationDir mLogfiledir mToRun txOutTableType = do allScripts <- getMigrationScripts migrationDir ranAll <- case (mLogfiledir, allScripts) of @@ -149,12 +149,12 @@ runMigrations pgconfig quiet migrationDir mLogfiledir mToRun txOutTableType = do filterIndexesFull (mv, _) = do case txOutTableType of - TxOutCore -> True + TxOutVariantCore -> True TxOutVariantAddress -> not $ mvStage mv == 4 && mvVersion mv == 1 filterInitial (mv, _) = mvStage mv < 4 filterIndexes (mv, _) = do case txOutTableType of - TxOutCore -> mvStage mv == 4 + TxOutVariantCore -> mvStage mv == 4 TxOutVariantAddress -> mvStage mv == 4 && mvVersion mv > 1 -- Build hash for each file found in a directory. @@ -222,7 +222,7 @@ applyMigration (MigrationDir location) quiet pgconfig mLogFilename logHandle (ve -- | Create a database migration (using functionality built into Persistent). If no -- migration is needed return 'Nothing' otherwise return the migration as 'Text'. -createMigration :: PGPassSource -> MigrationDir -> TxOutTableType -> IO (Maybe FilePath) +createMigration :: PGPassSource -> MigrationDir -> TxOutVariantType -> IO (Maybe FilePath) createMigration source (MigrationDir migdir) txOutTableType = do mt <- runDbNoLogging source create case mt of @@ -239,7 +239,7 @@ createMigration source (MigrationDir migdir) txOutTableType = do -- handle what type of migration to generate statements <- case txOutTableType of - TxOutCore -> do + TxOutVariantCore -> do statementsTxOut <- getMigration migrateCoreTxOutCardanoDb pure $ statementsBase <> statementsTxOut TxOutVariantAddress -> do diff --git a/cardano-db/src/Cardano/Db/Operations/Delete.hs b/cardano-db/src/Cardano/Db/Operations/Delete.hs index 7ec0f0bb2..b8d75f193 100644 --- a/cardano-db/src/Cardano/Db/Operations/Delete.hs +++ b/cardano-db/src/Cardano/Db/Operations/Delete.hs @@ -28,10 +28,10 @@ import Cardano.Db.Operations.Insert ( import Cardano.Db.Operations.Other.ConsumedTxOut (querySetNullTxOut) import Cardano.Db.Operations.Other.MinId (MinIds (..), MinIdsWrapper (..), completeMinId, textToMinIds) import Cardano.Db.Operations.Query -import Cardano.Db.Operations.Types (TxOutTableType (..)) +import Cardano.Db.Operations.Types (TxOutVariantType (..)) import Cardano.Db.Schema.BaseSchema -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Prelude (Int64) import Cardano.Slotting.Slot (SlotNo (..)) import Control.Monad (void) @@ -59,7 +59,7 @@ import Database.Persist.Sql (Filter, SqlBackend, delete, deleteWhere, deleteWher deleteBlocksSlotNo :: MonadIO m => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> SlotNo -> Bool -> ReaderT SqlBackend m Bool @@ -77,7 +77,7 @@ deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do deleteBlocksBlockId :: MonadIO m => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> BlockId -> -- | The 'EpochNo' of the block to delete. Word64 -> @@ -139,7 +139,7 @@ deleteUsingEpochNo epochN = do deleteTablesAfterBlockId :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> BlockId -> Maybe TxId -> MinIdsWrapper -> @@ -188,7 +188,7 @@ deleteTablesAfterBlockId txOutTableType blkId mtxId minIdsW = do deleteTablesAfterTxId :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> Maybe TxId -> MinIdsWrapper -> ReaderT SqlBackend m [(Text, Int64)] @@ -199,15 +199,15 @@ deleteTablesAfterTxId txOutTableType mtxId minIdsW = do concat <$> sequence [ maybe (pure []) (\txInId -> onlyDelete "TxIn" [TxInId >=. txInId]) mtxInId - , maybe (pure []) (\txOutId -> onlyDelete "TxOut" [C.TxOutId >=. txOutId]) mtxOutId - , maybe (pure []) (\maTxOutId -> onlyDelete "MaTxOut" [C.MaTxOutId >=. maTxOutId]) mmaTxOutId + , maybe (pure []) (\txOutId -> onlyDelete "TxOut" [VC.TxOutId >=. txOutId]) mtxOutId + , maybe (pure []) (\maTxOutId -> onlyDelete "MaTxOut" [VC.MaTxOutId >=. maTxOutId]) mmaTxOutId ] VMinIdsWrapper (MinIds mtxInId mtxOutId mmaTxOutId) -> concat <$> sequence [ maybe (pure []) (\txInId -> onlyDelete "TxIn" [TxInId >=. txInId]) mtxInId - , maybe (pure []) (\txOutId -> onlyDelete "TxOut" [V.TxOutId >=. txOutId]) mtxOutId - , maybe (pure []) (\maTxOutId -> onlyDelete "MaTxOut" [V.MaTxOutId >=. maTxOutId]) mmaTxOutId + , maybe (pure []) (\txOutId -> onlyDelete "TxOut" [VA.TxOutId >=. txOutId]) mtxOutId + , maybe (pure []) (\maTxOutId -> onlyDelete "MaTxOut" [VA.MaTxOutId >=. maTxOutId]) mmaTxOutId ] -- Handle deletions and log accumulation using the specified TxId txIdLogs <- case mtxId of @@ -218,8 +218,8 @@ deleteTablesAfterTxId txOutTableType mtxId minIdsW = do concat <$> sequence [ case txOutTableType of - TxOutCore -> queryDeleteAndLog "CollateralTxOut" C.CollateralTxOutTxId txId - TxOutVariantAddress -> queryDeleteAndLog "CollateralTxOut" V.CollateralTxOutTxId txId + TxOutVariantCore -> queryDeleteAndLog "CollateralTxOut" VC.CollateralTxOutTxId txId + TxOutVariantAddress -> queryDeleteAndLog "CollateralTxOut" VA.CollateralTxOutTxId txId , queryDeleteAndLog "CollateralTxIn" CollateralTxInTxInId txId , queryDeleteAndLog "ReferenceTxIn" ReferenceTxInTxInId txId , queryDeleteAndLog "PoolRetire" PoolRetireAnnouncedTxId txId @@ -376,18 +376,18 @@ mkRollbackSummary logs setNullLogs = -- Tools -deleteBlocksSlotNoNoTrace :: MonadIO m => TxOutTableType -> SlotNo -> ReaderT SqlBackend m Bool +deleteBlocksSlotNoNoTrace :: MonadIO m => TxOutVariantType -> SlotNo -> ReaderT SqlBackend m Bool deleteBlocksSlotNoNoTrace txOutTableType slotNo = deleteBlocksSlotNo nullTracer txOutTableType slotNo True -- Tests -deleteBlocksForTests :: MonadIO m => TxOutTableType -> BlockId -> Word64 -> ReaderT SqlBackend m () +deleteBlocksForTests :: MonadIO m => TxOutVariantType -> BlockId -> Word64 -> ReaderT SqlBackend m () deleteBlocksForTests txOutTableType blockId epochN = do void $ deleteBlocksBlockId nullTracer txOutTableType blockId epochN False -- | Delete a block if it exists. Returns 'True' if it did exist and has been -- deleted and 'False' if it did not exist. -deleteBlock :: MonadIO m => TxOutTableType -> Block -> ReaderT SqlBackend m Bool +deleteBlock :: MonadIO m => TxOutVariantType -> Block -> ReaderT SqlBackend m Bool deleteBlock txOutTableType block = do mBlockId <- queryBlockHash block case mBlockId of diff --git a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs index 513e93ee1..e00dff9cd 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs +++ b/cardano-db/src/Cardano/Db/Operations/Other/ConsumedTxOut.hs @@ -18,10 +18,10 @@ import Cardano.Db.Error (LookupFail (..), logAndThrowIO) import Cardano.Db.Operations.Insert (insertExtraMigration) import Cardano.Db.Operations.Query (listToMaybe, queryAllExtraMigrations, queryBlockHeight, queryBlockNo, queryMaxRefId) import Cardano.Db.Operations.QueryHelper (isJust) -import Cardano.Db.Operations.Types (TxOutFields (..), TxOutIdW (..), TxOutTable, TxOutTableType (..), isTxOutVariantAddress) +import Cardano.Db.Operations.Types (TxOutFields (..), TxOutIdW (..), TxOutTable, TxOutVariantType (..), isTxOutVariantAddress) import Cardano.Db.Schema.BaseSchema -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Db.Types (ExtraMigration (..), MigrationValues (..), PruneConsumeMigration (..), processMigrationValues) import Cardano.Prelude (textShow, void) import Control.Exception (throw) @@ -55,7 +55,7 @@ data ConsumedTriplet = ConsumedTriplet -------------------------------------------------------------------------------------------------- querySetNullTxOut :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> Maybe TxId -> ReaderT SqlBackend m (Text, Int64) querySetNullTxOut txOutTableType mMinTxId = do @@ -72,7 +72,7 @@ querySetNullTxOut txOutTableType mMinTxId = do getTxOutConsumedAfter :: MonadIO m => TxId -> ReaderT SqlBackend m [TxOutIdW] getTxOutConsumedAfter txId = case txOutTableType of - TxOutCore -> wrapTxOutIds CTxOutIdW (queryConsumedTxOutIds @'TxOutCore txId) + TxOutVariantCore -> wrapTxOutIds CTxOutIdW (queryConsumedTxOutIds @'TxOutVariantCore txId) TxOutVariantAddress -> wrapTxOutIds VTxOutIdW (queryConsumedTxOutIds @'TxOutVariantAddress txId) where wrapTxOutIds constructor = fmap (map constructor) @@ -93,7 +93,7 @@ querySetNullTxOut txOutTableType mMinTxId = do setNullTxOutConsumedAfter :: MonadIO m => TxOutIdW -> ReaderT SqlBackend m () setNullTxOutConsumedAfter txOutId = case txOutTableType of - TxOutCore -> setNull + TxOutVariantCore -> setNull TxOutVariantAddress -> setNull where setNull :: @@ -101,10 +101,10 @@ querySetNullTxOut txOutTableType mMinTxId = do ReaderT SqlBackend m () setNull = do case txOutId of - CTxOutIdW txOutId' -> update txOutId' [C.TxOutConsumedByTxId =. Nothing] - VTxOutIdW txOutId' -> update txOutId' [V.TxOutConsumedByTxId =. Nothing] + CTxOutIdW txOutId' -> update txOutId' [VC.TxOutConsumedByTxId =. Nothing] + VTxOutIdW txOutId' -> update txOutId' [VA.TxOutConsumedByTxId =. Nothing] -runExtraMigrations :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> TxOutTableType -> Word64 -> PruneConsumeMigration -> ReaderT SqlBackend m () +runExtraMigrations :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> TxOutVariantType -> Word64 -> PruneConsumeMigration -> ReaderT SqlBackend m () runExtraMigrations trce txOutTableType blockNoDiff pcm = do ems <- queryAllExtraMigrations isTxOutNull <- queryTxOutIsNull txOutTableType @@ -157,13 +157,13 @@ runExtraMigrations trce txOutTableType blockNoDiff pcm = do deleteConsumedTxOut trce txOutTableType blockNoDiff else deleteAndUpdateConsumedTxOut trce txOutTableType migrationValues blockNoDiff -queryWrongConsumedBy :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64 +queryWrongConsumedBy :: TxOutVariantType -> MonadIO m => ReaderT SqlBackend m Word64 queryWrongConsumedBy = \case - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word64 query = do @@ -178,13 +178,13 @@ queryWrongConsumedBy = \case -------------------------------------------------------------------------------------------------- -- | This is a count of the null consumed_by_tx_id -queryTxOutConsumedNullCount :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64 +queryTxOutConsumedNullCount :: TxOutVariantType -> MonadIO m => ReaderT SqlBackend m Word64 queryTxOutConsumedNullCount = \case - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word64 query = do @@ -194,13 +194,13 @@ queryTxOutConsumedNullCount = \case pure countRows pure $ maybe 0 unValue (listToMaybe res) -queryTxOutConsumedCount :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64 +queryTxOutConsumedCount :: TxOutVariantType -> MonadIO m => ReaderT SqlBackend m Word64 queryTxOutConsumedCount = \case - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word64 query = do @@ -210,13 +210,13 @@ queryTxOutConsumedCount = \case pure countRows pure $ maybe 0 unValue (listToMaybe res) -queryTxOutIsNull :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Bool +queryTxOutIsNull :: TxOutVariantType -> MonadIO m => ReaderT SqlBackend m Bool queryTxOutIsNull = \case - TxOutCore -> pure False + TxOutVariantCore -> pure False TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Bool query = do @@ -236,15 +236,15 @@ updateListTxOutConsumedByTxId ls = do updateTxOutConsumedByTxId :: MonadIO m => TxOutIdW -> TxId -> ReaderT SqlBackend m () updateTxOutConsumedByTxId txOutId txId = case txOutId of - CTxOutIdW txOutId' -> update txOutId' [C.TxOutConsumedByTxId =. Just txId] - VTxOutIdW txOutId' -> update txOutId' [V.TxOutConsumedByTxId =. Just txId] + CTxOutIdW txOutId' -> update txOutId' [VC.TxOutConsumedByTxId =. Just txId] + VTxOutIdW txOutId' -> update txOutId' [VA.TxOutConsumedByTxId =. Just txId] migrateTxOut :: ( MonadBaseControl IO m , MonadIO m ) => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> Maybe MigrationValues -> ReaderT SqlBackend m () migrateTxOut trce txOutTableType mMvs = do @@ -257,7 +257,7 @@ migrateTxOut trce txOutTableType mMvs = do void createPruneConstraintTxOut migrateNextPageTxOut (Just trce) txOutTableType 0 -migrateNextPageTxOut :: MonadIO m => Maybe (Trace IO Text) -> TxOutTableType -> Word64 -> ReaderT SqlBackend m () +migrateNextPageTxOut :: MonadIO m => Maybe (Trace IO Text) -> TxOutVariantType -> Word64 -> ReaderT SqlBackend m () migrateNextPageTxOut mTrce txOutTableType offst = do whenJust mTrce $ \trce -> liftIO $ logInfo trce $ "migrateNextPageTxOut: Handling input offset " <> textShow offst @@ -274,7 +274,7 @@ deleteAndUpdateConsumedTxOut :: forall m. (MonadIO m, MonadBaseControl IO m) => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> MigrationValues -> Word64 -> ReaderT SqlBackend m () @@ -303,7 +303,7 @@ splitAndProcessPageEntries :: forall m. (MonadIO m, MonadBaseControl IO m) => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> Bool -> TxId -> [ConsumedTriplet] -> @@ -343,29 +343,29 @@ shouldCreateConsumedTxOut trce rcc = -- | Update updatePageEntries :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> [ConsumedTriplet] -> ReaderT SqlBackend m () updatePageEntries txOutTableType = mapM_ (updateTxOutConsumedByTxIdUnique txOutTableType) -updateTxOutConsumedByTxIdUnique :: MonadIO m => TxOutTableType -> ConsumedTriplet -> ReaderT SqlBackend m () +updateTxOutConsumedByTxIdUnique :: MonadIO m => TxOutVariantType -> ConsumedTriplet -> ReaderT SqlBackend m () updateTxOutConsumedByTxIdUnique txOutTableType ConsumedTriplet {ctTxOutTxId, ctTxOutIndex, ctTxInTxId} = case txOutTableType of - TxOutCore -> updateWhere [C.TxOutTxId ==. ctTxOutTxId, C.TxOutIndex ==. ctTxOutIndex] [C.TxOutConsumedByTxId =. Just ctTxInTxId] - TxOutVariantAddress -> updateWhere [V.TxOutTxId ==. ctTxOutTxId, V.TxOutIndex ==. ctTxOutIndex] [V.TxOutConsumedByTxId =. Just ctTxInTxId] + TxOutVariantCore -> updateWhere [VC.TxOutTxId ==. ctTxOutTxId, VC.TxOutIndex ==. ctTxOutIndex] [VC.TxOutConsumedByTxId =. Just ctTxInTxId] + TxOutVariantAddress -> updateWhere [VA.TxOutTxId ==. ctTxOutTxId, VA.TxOutIndex ==. ctTxOutIndex] [VA.TxOutConsumedByTxId =. Just ctTxInTxId] -- this builds up a single delete query using the pageEntries list deletePageEntries :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> [ConsumedTriplet] -> ReaderT SqlBackend m () deletePageEntries txOutTableType = mapM_ (\ConsumedTriplet {ctTxOutTxId, ctTxOutIndex} -> deleteTxOutConsumed txOutTableType ctTxOutTxId ctTxOutIndex) -deleteTxOutConsumed :: MonadIO m => TxOutTableType -> TxId -> Word64 -> ReaderT SqlBackend m () +deleteTxOutConsumed :: MonadIO m => TxOutVariantType -> TxId -> Word64 -> ReaderT SqlBackend m () deleteTxOutConsumed txOutTableType txOutId index = case txOutTableType of - TxOutCore -> deleteWhere [C.TxOutTxId ==. txOutId, C.TxOutIndex ==. index] - TxOutVariantAddress -> deleteWhere [V.TxOutTxId ==. txOutId, V.TxOutIndex ==. index] + TxOutVariantCore -> deleteWhere [VC.TxOutTxId ==. txOutId, VC.TxOutIndex ==. index] + TxOutVariantAddress -> deleteWhere [VA.TxOutTxId ==. txOutId, VA.TxOutIndex ==. index] -------------------------------------------------------------------------------------------------- -- Raw Queries @@ -492,7 +492,7 @@ deleteConsumedTxOut :: forall m. MonadIO m => Trace IO Text -> - TxOutTableType -> + TxOutVariantType -> Word64 -> ReaderT SqlBackend m () deleteConsumedTxOut trce txOutTableType blockNoDiff = do @@ -501,17 +501,17 @@ deleteConsumedTxOut trce txOutTableType blockNoDiff = do Left errMsg -> liftIO $ logInfo trce $ "No tx_out was deleted: " <> errMsg Right mxtid -> deleteConsumedBeforeTx trce txOutTableType mxtid -deleteConsumedBeforeTx :: MonadIO m => Trace IO Text -> TxOutTableType -> TxId -> ReaderT SqlBackend m () +deleteConsumedBeforeTx :: MonadIO m => Trace IO Text -> TxOutVariantType -> TxId -> ReaderT SqlBackend m () deleteConsumedBeforeTx trce txOutTableType txId = do countDeleted <- case txOutTableType of - TxOutCore -> deleteWhereCount [C.TxOutConsumedByTxId <=. Just txId] - TxOutVariantAddress -> deleteWhereCount [V.TxOutConsumedByTxId <=. Just txId] + TxOutVariantCore -> deleteWhereCount [VC.TxOutConsumedByTxId <=. Just txId] + TxOutVariantAddress -> deleteWhereCount [VA.TxOutConsumedByTxId <=. Just txId] liftIO $ logInfo trce $ "Deleted " <> textShow countDeleted <> " tx_out" -------------------------------------------------------------------------------------------------- -- Helpers -------------------------------------------------------------------------------------------------- -migrateTxOutDbTool :: (MonadIO m, MonadBaseControl IO m) => TxOutTableType -> ReaderT SqlBackend m () +migrateTxOutDbTool :: (MonadIO m, MonadBaseControl IO m) => TxOutVariantType -> ReaderT SqlBackend m () migrateTxOutDbTool txOutTableType = do _ <- createConsumedIndexTxOut migrateNextPageTxOut Nothing txOutTableType 0 @@ -565,14 +565,14 @@ countTxIn = do countConsumed :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> ReaderT SqlBackend m Word64 countConsumed = \case - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word64 query = do diff --git a/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs b/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs index 06af87818..1e12ed628 100644 --- a/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs +++ b/cardano-db/src/Cardano/Db/Operations/Other/MinId.hs @@ -11,15 +11,15 @@ module Cardano.Db.Operations.Other.MinId where import Cardano.Db.Operations.Query (queryMinRefId) -import Cardano.Db.Operations.Types (MaTxOutFields (..), TxOutFields (..), TxOutTableType (..)) +import Cardano.Db.Operations.Types (MaTxOutFields (..), TxOutFields (..), TxOutVariantType (..)) import Cardano.Db.Schema.BaseSchema -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Prelude import qualified Data.Text as Text import Database.Persist.Sql (PersistEntity, PersistField, SqlBackend, fromSqlKey, toSqlKey) -data MinIds (a :: TxOutTableType) = MinIds +data MinIds (a :: TxOutVariantType) = MinIds { minTxInId :: Maybe TxInId , minTxOutId :: Maybe (TxOutIdFor a) , minMaTxOutId :: Maybe (MaTxOutIdFor a) @@ -37,7 +37,7 @@ instance (TxOutFields a, MaTxOutFields a, Ord (TxOutIdFor a), Ord (MaTxOutIdFor } data MinIdsWrapper - = CMinIdsWrapper (MinIds 'TxOutCore) + = CMinIdsWrapper (MinIds 'TxOutVariantCore) | VMinIdsWrapper (MinIds 'TxOutVariantAddress) instance Monoid MinIdsWrapper where @@ -52,13 +52,13 @@ minIdsToText :: MinIdsWrapper -> Text minIdsToText (CMinIdsWrapper minIds) = minIdsCoreToText minIds minIdsToText (VMinIdsWrapper minIds) = minIdsVariantToText minIds -textToMinIds :: TxOutTableType -> Text -> Maybe MinIdsWrapper +textToMinIds :: TxOutVariantType -> Text -> Maybe MinIdsWrapper textToMinIds txOutTableType txt = case txOutTableType of - TxOutCore -> CMinIdsWrapper <$> textToMinIdsCore txt + TxOutVariantCore -> CMinIdsWrapper <$> textToMinIdsCore txt TxOutVariantAddress -> VMinIdsWrapper <$> textToMinIdsVariant txt -minIdsCoreToText :: MinIds 'TxOutCore -> Text +minIdsCoreToText :: MinIds 'TxOutVariantCore -> Text minIdsCoreToText minIds = Text.intercalate ":" @@ -76,7 +76,7 @@ minIdsVariantToText minIds = , maybe "" (Text.pack . show . fromSqlKey) $ minMaTxOutId minIds ] -textToMinIdsCore :: Text -> Maybe (MinIds 'TxOutCore) +textToMinIdsCore :: Text -> Maybe (MinIds 'TxOutVariantCore) textToMinIdsCore txt = case Text.split (== ':') txt of [tminTxInId, tminTxOutId, tminMaTxOutId] -> @@ -117,16 +117,16 @@ completeMinId mTxId mIdW = case mIdW of CMinIdsWrapper minIds -> CMinIdsWrapper <$> completeMinIdCore mTxId minIds VMinIdsWrapper minIds -> VMinIdsWrapper <$> completeMinIdVariant mTxId minIds -completeMinIdCore :: MonadIO m => Maybe TxId -> MinIds 'TxOutCore -> ReaderT SqlBackend m (MinIds 'TxOutCore) +completeMinIdCore :: MonadIO m => Maybe TxId -> MinIds 'TxOutVariantCore -> ReaderT SqlBackend m (MinIds 'TxOutVariantCore) completeMinIdCore mTxId minIds = do case mTxId of Nothing -> pure mempty Just txId -> do mTxInId <- whenNothingQueryMinRefId (minTxInId minIds) TxInTxInId txId - mTxOutId <- whenNothingQueryMinRefId (minTxOutId minIds) C.TxOutTxId txId + mTxOutId <- whenNothingQueryMinRefId (minTxOutId minIds) VC.TxOutTxId txId mMaTxOutId <- case mTxOutId of Nothing -> pure Nothing - Just txOutId -> whenNothingQueryMinRefId (minMaTxOutId minIds) C.MaTxOutTxOutId txOutId + Just txOutId -> whenNothingQueryMinRefId (minMaTxOutId minIds) VC.MaTxOutTxOutId txOutId pure $ MinIds { minTxInId = mTxInId @@ -140,10 +140,10 @@ completeMinIdVariant mTxId minIds = do Nothing -> pure mempty Just txId -> do mTxInId <- whenNothingQueryMinRefId (minTxInId minIds) TxInTxInId txId - mTxOutId <- whenNothingQueryMinRefId (minTxOutId minIds) V.TxOutTxId txId + mTxOutId <- whenNothingQueryMinRefId (minTxOutId minIds) VA.TxOutTxId txId mMaTxOutId <- case mTxOutId of Nothing -> pure Nothing - Just txOutId -> whenNothingQueryMinRefId (minMaTxOutId minIds) V.MaTxOutTxOutId txOutId + Just txOutId -> whenNothingQueryMinRefId (minMaTxOutId minIds) VA.MaTxOutTxOutId txOutId pure $ MinIds { minTxInId = mTxInId diff --git a/cardano-db/src/Cardano/Db/Operations/Query.hs b/cardano-db/src/Cardano/Db/Operations/Query.hs index 207dad0ab..46001cca4 100644 --- a/cardano-db/src/Cardano/Db/Operations/Query.hs +++ b/cardano-db/src/Cardano/Db/Operations/Query.hs @@ -166,7 +166,6 @@ import Database.Persist.Class.PersistQuery (selectList) import Database.Persist.Types (SelectOpt (Asc)) {- HLINT ignore "Redundant ^." -} -{- HLINT ignore "Fuse on/on" -} {- HLINT ignore "Reduce duplication" -} -- If you squint, these Esqueleto queries almost look like SQL queries. diff --git a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutDelete.hs b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutDelete.hs index f17328aa4..8d63aaa0d 100644 --- a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutDelete.hs +++ b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutDelete.hs @@ -5,9 +5,9 @@ module Cardano.Db.Operations.TxOut.TxOutDelete where -import Cardano.Db.Operations.Types (TxOutTableType (..)) -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import Cardano.Db.Operations.Types (TxOutVariantType (..)) +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Prelude (Int64) import Control.Monad.Extra (whenJust) import Control.Monad.IO.Class (MonadIO) @@ -23,17 +23,17 @@ import Database.Persist.Sql ( -------------------------------------------------------------------------------- -- Delete -------------------------------------------------------------------------------- -deleteCoreTxOutTablesAfterTxId :: MonadIO m => Maybe C.TxOutId -> Maybe C.MaTxOutId -> ReaderT SqlBackend m () +deleteCoreTxOutTablesAfterTxId :: MonadIO m => Maybe VC.TxOutId -> Maybe VC.MaTxOutId -> ReaderT SqlBackend m () deleteCoreTxOutTablesAfterTxId mtxOutId mmaTxOutId = do - whenJust mmaTxOutId $ \maTxOutId -> deleteWhere [C.MaTxOutId >=. maTxOutId] - whenJust mtxOutId $ \txOutId -> deleteWhere [C.TxOutId >=. txOutId] + whenJust mmaTxOutId $ \maTxOutId -> deleteWhere [VC.MaTxOutId >=. maTxOutId] + whenJust mtxOutId $ \txOutId -> deleteWhere [VC.TxOutId >=. txOutId] -deleteVariantTxOutTablesAfterTxId :: MonadIO m => Maybe V.TxOutId -> Maybe V.MaTxOutId -> ReaderT SqlBackend m () +deleteVariantTxOutTablesAfterTxId :: MonadIO m => Maybe VA.TxOutId -> Maybe VA.MaTxOutId -> ReaderT SqlBackend m () deleteVariantTxOutTablesAfterTxId mtxOutId mmaTxOutId = do - whenJust mmaTxOutId $ \maTxOutId -> deleteWhere [V.MaTxOutId >=. maTxOutId] - whenJust mtxOutId $ \txOutId -> deleteWhere [V.TxOutId >=. txOutId] + whenJust mmaTxOutId $ \maTxOutId -> deleteWhere [VA.MaTxOutId >=. maTxOutId] + whenJust mtxOutId $ \txOutId -> deleteWhere [VA.TxOutId >=. txOutId] -deleteTxOut :: MonadIO m => TxOutTableType -> ReaderT SqlBackend m Int64 +deleteTxOut :: MonadIO m => TxOutVariantType -> ReaderT SqlBackend m Int64 deleteTxOut = \case - TxOutCore -> deleteWhereCount ([] :: [Filter C.TxOut]) - TxOutVariantAddress -> deleteWhereCount ([] :: [Filter V.TxOut]) + TxOutVariantCore -> deleteWhereCount ([] :: [Filter VC.TxOut]) + TxOutVariantAddress -> deleteWhereCount ([] :: [Filter VA.TxOut]) diff --git a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutInsert.hs b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutInsert.hs index b00e93085..7b931a807 100644 --- a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutInsert.hs +++ b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutInsert.hs @@ -9,8 +9,8 @@ module Cardano.Db.Operations.TxOut.TxOutInsert where import Cardano.Db.Operations.Insert (insertMany', insertUnchecked) import Cardano.Db.Operations.Types (CollateralTxOutIdW (..), CollateralTxOutW (..), MaTxOutIdW (..), MaTxOutW (..), TxOutIdW (..), TxOutW (..)) -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Reader (ReaderT) @@ -40,11 +40,11 @@ insertManyTxOut disInOut txOutWs = do vals <- insertMany' "insertManyTxOutV" (map extractVariantTxOut txOuts) pure $ map VTxOutIdW vals where - extractCoreTxOut :: TxOutW -> C.TxOut + extractCoreTxOut :: TxOutW -> VC.TxOut extractCoreTxOut (CTxOutW txOut) = txOut extractCoreTxOut (VTxOutW _ _) = error "Unexpected VTxOutW in CoreTxOut list" - extractVariantTxOut :: TxOutW -> V.TxOut + extractVariantTxOut :: TxOutW -> VA.TxOut extractVariantTxOut (VTxOutW txOut _) = txOut extractVariantTxOut (CTxOutW _) = error "Unexpected CTxOutW in VariantTxOut list" @@ -64,7 +64,7 @@ insertTxOut txOutW = do -------------------------------------------------------------------------------- -- insertAddress - Insert a Address into the database. -------------------------------------------------------------------------------- -insertAddress :: (MonadBaseControl IO m, MonadIO m) => V.Address -> ReaderT SqlBackend m V.AddressId +insertAddress :: (MonadBaseControl IO m, MonadIO m) => VA.Address -> ReaderT SqlBackend m VA.AddressId insertAddress = insertUnchecked "insertAddress" -------------------------------------------------------------------------------- @@ -83,11 +83,11 @@ insertManyMaTxOut maTxOutWs = do vals <- insertMany' "Many Variant MaTxOut" (map extractVariantMaTxOut maTxOuts) pure $ map VMaTxOutIdW vals where - extractCoreMaTxOut :: MaTxOutW -> C.MaTxOut + extractCoreMaTxOut :: MaTxOutW -> VC.MaTxOut extractCoreMaTxOut (CMaTxOutW maTxOut) = maTxOut extractCoreMaTxOut (VMaTxOutW _) = error "Unexpected VMaTxOutW in CoreMaTxOut list" - extractVariantMaTxOut :: MaTxOutW -> V.MaTxOut + extractVariantMaTxOut :: MaTxOutW -> VA.MaTxOut extractVariantMaTxOut (VMaTxOutW maTxOut) = maTxOut extractVariantMaTxOut (CMaTxOutW _) = error "Unexpected CMaTxOutW in VariantMaTxOut list" diff --git a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs index 04441e261..4249e254c 100644 --- a/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs +++ b/cardano-db/src/Cardano/Db/Operations/TxOut/TxOutQuery.hs @@ -15,10 +15,10 @@ module Cardano.Db.Operations.TxOut.TxOutQuery where import Cardano.Db.Error (LookupFail (..)) import Cardano.Db.Operations.QueryHelper (isJust, maybeToEither, txLessEqual, unValue2, unValue3, unValueSumAda) -import Cardano.Db.Operations.Types (TxOutFields (..), TxOutIdW (..), TxOutTableType (..), TxOutW (..), UtxoQueryResult (..)) +import Cardano.Db.Operations.Types (TxOutFields (..), TxOutIdW (..), TxOutVariantType (..), TxOutW (..), UtxoQueryResult (..)) import Cardano.Db.Schema.BaseSchema -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Db.Types (Ada, DbLovelace (..)) import Cardano.Prelude (Bifunctor (second), ByteString, ReaderT, Text, Word64, listToMaybe, mapMaybe) import Control.Monad.IO.Class (MonadIO) @@ -51,10 +51,9 @@ import Database.Esqueleto.Experimental ( type (:&) ((:&)), ) -{- HLINT ignore "Fuse on/on" -} {- HLINT ignore "Redundant ^." -} --- Some Queries can accept TxOutTableType as a parameter, whilst others that return a TxOut related value can't +-- Some Queries can accept TxOutVariantType as a parameter, whilst others that return a TxOut related value can't -- as they wiil either deal with Core or Variant TxOut/Address types. -- These types also need to be handled at the call site. @@ -65,16 +64,16 @@ import Database.Esqueleto.Experimental ( -- | Like 'queryTxId' but also return the 'TxOutIdValue' of the transaction output. queryTxOutValue :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, DbLovelace)) queryTxOutValue txOutTableType hashIndex = case txOutTableType of - TxOutCore -> queryTxOutValue' @'TxOutCore hashIndex + TxOutVariantCore -> queryTxOutValue' @'TxOutVariantCore hashIndex TxOutVariantAddress -> queryTxOutValue' @'TxOutVariantAddress hashIndex where queryTxOutValue' :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, DbLovelace)) @@ -96,12 +95,12 @@ queryTxOutValue txOutTableType hashIndex = -- | Like 'queryTxId' but also return the 'TxOutId' of the transaction output. queryTxOutId :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdW)) queryTxOutId txOutTableType hashIndex = case txOutTableType of - TxOutCore -> wrapTxOutId CTxOutIdW (queryTxOutId' @'TxOutCore hashIndex) + TxOutVariantCore -> wrapTxOutId CTxOutIdW (queryTxOutId' @'TxOutVariantCore hashIndex) TxOutVariantAddress -> wrapTxOutId VTxOutIdW (queryTxOutId' @'TxOutVariantAddress hashIndex) where wrapTxOutId constructor = fmap (fmap (second constructor)) @@ -129,19 +128,19 @@ queryTxOutId txOutTableType hashIndex = -- | Like 'queryTxOutId' but also return the 'TxOutIdValue' queryTxOutIdValue :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdW, DbLovelace)) -queryTxOutIdValue getTxOutTableType hashIndex = do - case getTxOutTableType of - TxOutCore -> wrapTxOutId CTxOutIdW (queryTxOutIdValue' @'TxOutCore hashIndex) +queryTxOutIdValue getTxOutVariantType hashIndex = do + case getTxOutVariantType of + TxOutVariantCore -> wrapTxOutId CTxOutIdW (queryTxOutIdValue' @'TxOutVariantCore hashIndex) TxOutVariantAddress -> wrapTxOutId VTxOutIdW (queryTxOutIdValue' @'TxOutVariantAddress hashIndex) where wrapTxOutId constructor = fmap (fmap (\(txId, txOutId, lovelace) -> (txId, constructor txOutId, lovelace))) queryTxOutIdValue' :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (TxId, TxOutIdFor a, DbLovelace)) @@ -163,12 +162,12 @@ queryTxOutIdValue getTxOutTableType hashIndex = do -- | Give a (tx hash, index) pair, return the TxOut Credentials. queryTxOutCredentials :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (Maybe ByteString, Bool)) queryTxOutCredentials txOutTableType (hash, index) = case txOutTableType of - TxOutCore -> queryTxOutCredentialsCore (hash, index) + TxOutVariantCore -> queryTxOutCredentialsCore (hash, index) TxOutVariantAddress -> queryTxOutCredentialsVariant (hash, index) queryTxOutCredentialsCore :: MonadIO m => (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (Maybe ByteString, Bool)) @@ -177,10 +176,10 @@ queryTxOutCredentialsCore (hash, index) = do (tx :& txOut) <- from $ table @Tx - `innerJoin` table @C.TxOut - `on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. C.TxOutTxId) - where_ (txOut ^. C.TxOutIndex ==. val index &&. tx ^. TxHash ==. val hash) - pure (txOut ^. C.TxOutPaymentCred, txOut ^. C.TxOutAddressHasScript) + `innerJoin` table @VC.TxOut + `on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. VC.TxOutTxId) + where_ (txOut ^. VC.TxOutIndex ==. val index &&. tx ^. TxHash ==. val hash) + pure (txOut ^. VC.TxOutPaymentCred, txOut ^. VC.TxOutAddressHasScript) pure $ maybeToEither (DbLookupTxHash hash) unValue2 (listToMaybe res) queryTxOutCredentialsVariant :: MonadIO m => (ByteString, Word64) -> ReaderT SqlBackend m (Either LookupFail (Maybe ByteString, Bool)) @@ -189,24 +188,24 @@ queryTxOutCredentialsVariant (hash, index) = do (tx :& txOut :& address) <- from $ ( table @Tx - `innerJoin` table @V.TxOut - `on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. V.TxOutTxId) + `innerJoin` table @VA.TxOut + `on` (\(tx :& txOut) -> tx ^. TxId ==. txOut ^. VA.TxOutTxId) ) - `innerJoin` table @V.Address - `on` (\((_ :& txOut) :& address) -> txOut ^. V.TxOutAddressId ==. address ^. V.AddressId) - where_ (txOut ^. V.TxOutIndex ==. val index &&. tx ^. TxHash ==. val hash) - pure (address ^. V.AddressPaymentCred, address ^. V.AddressHasScript) + `innerJoin` table @VA.Address + `on` (\((_ :& txOut) :& address) -> txOut ^. VA.TxOutAddressId ==. address ^. VA.AddressId) + where_ (txOut ^. VA.TxOutIndex ==. val index &&. tx ^. TxHash ==. val hash) + pure (address ^. VA.AddressPaymentCred, address ^. VA.AddressHasScript) pure $ maybeToEither (DbLookupTxHash hash) unValue2 (listToMaybe res) -------------------------------------------------------------------------------- -- ADDRESS QUERIES -------------------------------------------------------------------------------- -queryAddressId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe V.AddressId) +queryAddressId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe VA.AddressId) queryAddressId addrRaw = do res <- select $ do - addr <- from $ table @V.Address - where_ (addr ^. V.AddressRaw ==. val addrRaw) - pure (addr ^. V.AddressId) + addr <- from $ table @VA.Address + where_ (addr ^. VA.AddressRaw ==. val addrRaw) + pure (addr ^. VA.AddressId) pure $ unValue <$> listToMaybe res -------------------------------------------------------------------------------- @@ -218,15 +217,15 @@ queryAddressId addrRaw = do -- rewards are part of the ledger state and hence not on chain. queryTotalSupply :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> ReaderT SqlBackend m Ada queryTotalSupply txOutTableType = case txOutTableType of - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Ada query = do @@ -243,15 +242,15 @@ queryTotalSupply txOutTableType = -- | Return the total Genesis coin supply. queryGenesisSupply :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> ReaderT SqlBackend m Ada queryGenesisSupply txOutTableType = case txOutTableType of - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Ada query = do @@ -290,14 +289,14 @@ txOutUnspentP txOut = -- | Return the total Shelley Genesis coin supply. The Shelley Genesis Block -- is the unique which has a non-null PreviousId, but has null Epoch. -queryShelleyGenesisSupply :: MonadIO m => TxOutTableType -> ReaderT SqlBackend m Ada +queryShelleyGenesisSupply :: MonadIO m => TxOutVariantType -> ReaderT SqlBackend m Ada queryShelleyGenesisSupply txOutTableType = case txOutTableType of - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Ada query = do @@ -321,7 +320,7 @@ queryShelleyGenesisSupply txOutTableType = -------------------------------------------------------------------------------- -- queryUtxoAtBlockNo -------------------------------------------------------------------------------- -queryUtxoAtBlockNo :: MonadIO m => TxOutTableType -> Word64 -> ReaderT SqlBackend m [UtxoQueryResult] +queryUtxoAtBlockNo :: MonadIO m => TxOutVariantType -> Word64 -> ReaderT SqlBackend m [UtxoQueryResult] queryUtxoAtBlockNo txOutTableType blkNo = do eblkId <- select $ do blk <- from $ table @Block @@ -332,7 +331,7 @@ queryUtxoAtBlockNo txOutTableType blkNo = do -------------------------------------------------------------------------------- -- queryUtxoAtSlotNo -------------------------------------------------------------------------------- -queryUtxoAtSlotNo :: MonadIO m => TxOutTableType -> Word64 -> ReaderT SqlBackend m [UtxoQueryResult] +queryUtxoAtSlotNo :: MonadIO m => TxOutVariantType -> Word64 -> ReaderT SqlBackend m [UtxoQueryResult] queryUtxoAtSlotNo txOutTableType slotNo = do eblkId <- select $ do blk <- from $ table @Block @@ -343,10 +342,10 @@ queryUtxoAtSlotNo txOutTableType slotNo = do -------------------------------------------------------------------------------- -- queryUtxoAtBlockId -------------------------------------------------------------------------------- -queryUtxoAtBlockId :: MonadIO m => TxOutTableType -> BlockId -> ReaderT SqlBackend m [UtxoQueryResult] +queryUtxoAtBlockId :: MonadIO m => TxOutVariantType -> BlockId -> ReaderT SqlBackend m [UtxoQueryResult] queryUtxoAtBlockId txOutTableType blkid = case txOutTableType of - TxOutCore -> queryUtxoAtBlockIdCore blkid + TxOutVariantCore -> queryUtxoAtBlockIdCore blkid TxOutVariantAddress -> queryUtxoAtBlockIdVariant blkid queryUtxoAtBlockIdCore :: MonadIO m => BlockId -> ReaderT SqlBackend m [UtxoQueryResult] @@ -354,23 +353,23 @@ queryUtxoAtBlockIdCore blkid = do outputs <- select $ do (txout :& _txin :& _tx1 :& blk :& tx2) <- from $ - table @C.TxOut + table @VC.TxOut `leftJoin` table @TxIn `on` ( \(txout :& txin) -> - (just (txout ^. C.TxOutTxId) ==. txin ?. TxInTxOutId) - &&. (just (txout ^. C.TxOutIndex) ==. txin ?. TxInTxOutIndex) + (just (txout ^. VC.TxOutTxId) ==. txin ?. TxInTxOutId) + &&. (just (txout ^. VC.TxOutIndex) ==. txin ?. TxInTxOutIndex) ) `leftJoin` table @Tx `on` (\(_txout :& txin :& tx1) -> txin ?. TxInTxInId ==. tx1 ?. TxId) `leftJoin` table @Block `on` (\(_txout :& _txin :& tx1 :& blk) -> tx1 ?. TxBlockId ==. blk ?. BlockId) `leftJoin` table @Tx - `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. C.TxOutTxId) ==. tx2 ?. TxId) + `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. VC.TxOutTxId) ==. tx2 ?. TxId) where_ $ - (txout ^. C.TxOutTxId `in_` txLessEqual blkid) + (txout ^. VC.TxOutTxId `in_` txLessEqual blkid) &&. (isNothing (blk ?. BlockBlockNo) ||. (blk ?. BlockId >. just (val blkid))) - pure (txout, txout ^. C.TxOutAddress, tx2 ?. TxHash) + pure (txout, txout ^. VC.TxOutAddress, tx2 ?. TxHash) pure $ mapMaybe convertCore outputs queryUtxoAtBlockIdVariant :: MonadIO m => BlockId -> ReaderT SqlBackend m [UtxoQueryResult] @@ -378,28 +377,28 @@ queryUtxoAtBlockIdVariant blkid = do outputs <- select $ do (txout :& _txin :& _tx1 :& blk :& tx2 :& address) <- from $ - table @V.TxOut + table @VA.TxOut `leftJoin` table @TxIn `on` ( \(txout :& txin) -> - (just (txout ^. V.TxOutTxId) ==. txin ?. TxInTxOutId) - &&. (just (txout ^. V.TxOutIndex) ==. txin ?. TxInTxOutIndex) + (just (txout ^. VA.TxOutTxId) ==. txin ?. TxInTxOutId) + &&. (just (txout ^. VA.TxOutIndex) ==. txin ?. TxInTxOutIndex) ) `leftJoin` table @Tx `on` (\(_txout :& txin :& tx1) -> txin ?. TxInTxInId ==. tx1 ?. TxId) `leftJoin` table @Block `on` (\(_txout :& _txin :& tx1 :& blk) -> tx1 ?. TxBlockId ==. blk ?. BlockId) `leftJoin` table @Tx - `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. V.TxOutTxId) ==. tx2 ?. TxId) - `innerJoin` table @V.Address - `on` (\(txout :& _ :& _ :& _ :& _ :& address) -> txout ^. V.TxOutAddressId ==. address ^. V.AddressId) + `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. VA.TxOutTxId) ==. tx2 ?. TxId) + `innerJoin` table @VA.Address + `on` (\(txout :& _ :& _ :& _ :& _ :& address) -> txout ^. VA.TxOutAddressId ==. address ^. VA.AddressId) where_ $ - (txout ^. V.TxOutTxId `in_` txLessEqual blkid) + (txout ^. VA.TxOutTxId `in_` txLessEqual blkid) &&. (isNothing (blk ?. BlockBlockNo) ||. (blk ?. BlockId >. just (val blkid))) pure (txout, address, tx2 ?. TxHash) pure $ mapMaybe convertVariant outputs -convertCore :: (Entity C.TxOut, Value Text, Value (Maybe ByteString)) -> Maybe UtxoQueryResult +convertCore :: (Entity VC.TxOut, Value Text, Value (Maybe ByteString)) -> Maybe UtxoQueryResult convertCore (out, Value address, Value (Just hash')) = Just $ UtxoQueryResult @@ -409,12 +408,12 @@ convertCore (out, Value address, Value (Just hash')) = } convertCore _ = Nothing -convertVariant :: (Entity V.TxOut, Entity V.Address, Value (Maybe ByteString)) -> Maybe UtxoQueryResult +convertVariant :: (Entity VA.TxOut, Entity VA.Address, Value (Maybe ByteString)) -> Maybe UtxoQueryResult convertVariant (out, address, Value (Just hash')) = Just $ UtxoQueryResult { utxoTxOutW = VTxOutW (entityVal out) (Just (entityVal address)) - , utxoAddress = V.addressAddress $ entityVal address + , utxoAddress = VA.addressAddress $ entityVal address , utxoTxHash = hash' } convertVariant _ = Nothing @@ -422,7 +421,7 @@ convertVariant _ = Nothing -------------------------------------------------------------------------------- -- queryAddressBalanceAtSlot -------------------------------------------------------------------------------- -queryAddressBalanceAtSlot :: MonadIO m => TxOutTableType -> Text -> Word64 -> ReaderT SqlBackend m Ada +queryAddressBalanceAtSlot :: MonadIO m => TxOutVariantType -> Text -> Word64 -> ReaderT SqlBackend m Ada queryAddressBalanceAtSlot txOutTableType addr slotNo = do eblkId <- select $ do blk <- from (table @Block) @@ -435,94 +434,94 @@ queryAddressBalanceAtSlot txOutTableType addr slotNo = do -- tx1 refers to the tx of the input spending this output (if it is ever spent) -- tx2 refers to the tx of the output case txOutTableType of - TxOutCore -> do + TxOutVariantCore -> do res <- select $ do (txout :& _ :& _ :& blk :& _) <- from $ - table @C.TxOut + table @VC.TxOut `leftJoin` table @TxIn - `on` (\(txout :& txin) -> just (txout ^. C.TxOutTxId) ==. txin ?. TxInTxOutId) + `on` (\(txout :& txin) -> just (txout ^. VC.TxOutTxId) ==. txin ?. TxInTxOutId) `leftJoin` table @Tx `on` (\(_ :& txin :& tx1) -> txin ?. TxInTxInId ==. tx1 ?. TxId) `leftJoin` table @Block `on` (\(_ :& _ :& tx1 :& blk) -> tx1 ?. TxBlockId ==. blk ?. BlockId) `leftJoin` table @Tx - `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. C.TxOutTxId) ==. tx2 ?. TxId) + `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. VC.TxOutTxId) ==. tx2 ?. TxId) where_ $ - (txout ^. C.TxOutTxId `in_` txLessEqual blkid) + (txout ^. VC.TxOutTxId `in_` txLessEqual blkid) &&. (isNothing (blk ?. BlockBlockNo) ||. (blk ?. BlockId >. just (val blkid))) - where_ (txout ^. C.TxOutAddress ==. val addr) - pure $ sum_ (txout ^. C.TxOutValue) + where_ (txout ^. VC.TxOutAddress ==. val addr) + pure $ sum_ (txout ^. VC.TxOutValue) pure $ unValueSumAda (listToMaybe res) TxOutVariantAddress -> do res <- select $ do (txout :& _ :& _ :& blk :& _ :& address) <- from $ - table @V.TxOut + table @VA.TxOut `leftJoin` table @TxIn - `on` (\(txout :& txin) -> just (txout ^. V.TxOutTxId) ==. txin ?. TxInTxOutId) + `on` (\(txout :& txin) -> just (txout ^. VA.TxOutTxId) ==. txin ?. TxInTxOutId) `leftJoin` table @Tx `on` (\(_ :& txin :& tx1) -> txin ?. TxInTxInId ==. tx1 ?. TxId) `leftJoin` table @Block `on` (\(_ :& _ :& tx1 :& blk) -> tx1 ?. TxBlockId ==. blk ?. BlockId) `leftJoin` table @Tx - `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. V.TxOutTxId) ==. tx2 ?. TxId) - `innerJoin` table @V.Address - `on` (\(txout :& _ :& _ :& _ :& _ :& address) -> txout ^. V.TxOutAddressId ==. address ^. V.AddressId) + `on` (\(txout :& _ :& _ :& _ :& tx2) -> just (txout ^. VA.TxOutTxId) ==. tx2 ?. TxId) + `innerJoin` table @VA.Address + `on` (\(txout :& _ :& _ :& _ :& _ :& address) -> txout ^. VA.TxOutAddressId ==. address ^. VA.AddressId) where_ $ - (txout ^. V.TxOutTxId `in_` txLessEqual blkid) + (txout ^. VA.TxOutTxId `in_` txLessEqual blkid) &&. (isNothing (blk ?. BlockBlockNo) ||. (blk ?. BlockId >. just (val blkid))) - where_ (address ^. V.AddressAddress ==. val addr) - pure $ sum_ (txout ^. V.TxOutValue) + where_ (address ^. VA.AddressAddress ==. val addr) + pure $ sum_ (txout ^. VA.TxOutValue) pure $ unValueSumAda (listToMaybe res) -------------------------------------------------------------------------------- -- queryScriptOutputs -------------------------------------------------------------------------------- -queryScriptOutputs :: MonadIO m => TxOutTableType -> ReaderT SqlBackend m [TxOutW] +queryScriptOutputs :: MonadIO m => TxOutVariantType -> ReaderT SqlBackend m [TxOutW] queryScriptOutputs txOutTableType = case txOutTableType of - TxOutCore -> fmap (map CTxOutW) queryScriptOutputsCore + TxOutVariantCore -> fmap (map CTxOutW) queryScriptOutputsCore TxOutVariantAddress -> queryScriptOutputsVariant -queryScriptOutputsCore :: MonadIO m => ReaderT SqlBackend m [C.TxOut] +queryScriptOutputsCore :: MonadIO m => ReaderT SqlBackend m [VC.TxOut] queryScriptOutputsCore = do res <- select $ do - tx_out <- from $ table @C.TxOut - where_ (tx_out ^. C.TxOutAddressHasScript ==. val True) + tx_out <- from $ table @VC.TxOut + where_ (tx_out ^. VC.TxOutAddressHasScript ==. val True) pure tx_out pure $ entityVal <$> res queryScriptOutputsVariant :: MonadIO m => ReaderT SqlBackend m [TxOutW] queryScriptOutputsVariant = do res <- select $ do - address <- from $ table @V.Address - tx_out <- from $ table @V.TxOut - where_ (address ^. V.AddressHasScript ==. val True) - where_ (tx_out ^. V.TxOutAddressId ==. address ^. V.AddressId) + address <- from $ table @VA.Address + tx_out <- from $ table @VA.TxOut + where_ (address ^. VA.AddressHasScript ==. val True) + where_ (tx_out ^. VA.TxOutAddressId ==. address ^. VA.AddressId) pure (tx_out, address) pure $ map (uncurry combineToWrapper) res where - combineToWrapper :: Entity V.TxOut -> Entity V.Address -> TxOutW + combineToWrapper :: Entity VA.TxOut -> Entity VA.Address -> TxOutW combineToWrapper txOut address = VTxOutW (entityVal txOut) (Just (entityVal address)) -------------------------------------------------------------------------------- -- queryAddressOutputs -------------------------------------------------------------------------------- -queryAddressOutputs :: MonadIO m => TxOutTableType -> Text -> ReaderT SqlBackend m DbLovelace +queryAddressOutputs :: MonadIO m => TxOutVariantType -> Text -> ReaderT SqlBackend m DbLovelace queryAddressOutputs txOutTableType addr = do res <- case txOutTableType of - TxOutCore -> select $ do - txout <- from $ table @C.TxOut - where_ (txout ^. C.TxOutAddress ==. val addr) - pure $ sum_ (txout ^. C.TxOutValue) + TxOutVariantCore -> select $ do + txout <- from $ table @VC.TxOut + where_ (txout ^. VC.TxOutAddress ==. val addr) + pure $ sum_ (txout ^. VC.TxOutValue) TxOutVariantAddress -> select $ do - address <- from $ table @V.Address - txout <- from $ table @V.TxOut - where_ (address ^. V.AddressAddress ==. val addr) - where_ (txout ^. V.TxOutAddressId ==. address ^. V.AddressId) - pure $ sum_ (txout ^. V.TxOutValue) + address <- from $ table @VA.Address + txout <- from $ table @VA.TxOut + where_ (address ^. VA.AddressAddress ==. val addr) + where_ (txout ^. VA.TxOutAddressId ==. address ^. VA.AddressId) + pure $ sum_ (txout ^. VA.TxOutValue) pure $ convert (listToMaybe res) where convert v = case unValue <$> v of @@ -536,15 +535,15 @@ queryAddressOutputs txOutTableType addr = do -- | Count the number of transaction outputs in the TxOut table. queryTxOutCount :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> ReaderT SqlBackend m Word queryTxOutCount txOutTableType = do case txOutTableType of - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word query = do @@ -553,15 +552,15 @@ queryTxOutCount txOutTableType = do queryTxOutUnspentCount :: MonadIO m => - TxOutTableType -> + TxOutVariantType -> ReaderT SqlBackend m Word64 queryTxOutUnspentCount txOutTableType = case txOutTableType of - TxOutCore -> query @'TxOutCore + TxOutVariantCore -> query @'TxOutVariantCore TxOutVariantAddress -> query @'TxOutVariantAddress where query :: - forall (a :: TxOutTableType) m. + forall (a :: TxOutVariantType) m. (MonadIO m, TxOutFields a) => ReaderT SqlBackend m Word64 query = do diff --git a/cardano-db/src/Cardano/Db/Operations/Types.hs b/cardano-db/src/Cardano/Db/Operations/Types.hs index b92aafcc0..089d4db63 100644 --- a/cardano-db/src/Cardano/Db/Operations/Types.hs +++ b/cardano-db/src/Cardano/Db/Operations/Types.hs @@ -9,15 +9,15 @@ module Cardano.Db.Operations.Types where import Cardano.Db.Schema.BaseSchema -import qualified Cardano.Db.Schema.Core.TxOut as C -import qualified Cardano.Db.Schema.Variant.TxOut as V +import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Cardano.Db.Types (DbLovelace (..), DbWord64) import Cardano.Prelude (ByteString, Text, Word64, mapMaybe) import Data.Kind (Type) import Database.Esqueleto.Experimental (PersistEntity (..)) import Database.Persist.Sql (PersistField) -data TxOutTableType = TxOutCore | TxOutVariantAddress +data TxOutVariantType = TxOutVariantCore | TxOutVariantAddress deriving (Eq, Show) -------------------------------------------------------------------------------- @@ -26,17 +26,17 @@ data TxOutTableType = TxOutCore | TxOutVariantAddress -- | A wrapper for TxOut that allows us to handle both Core and Variant TxOuts data TxOutW - = CTxOutW !C.TxOut - | VTxOutW !V.TxOut !(Maybe V.Address) + = CTxOutW !VC.TxOut + | VTxOutW !VA.TxOut !(Maybe VA.Address) -- | A wrapper for TxOutId data TxOutIdW - = CTxOutIdW !C.TxOutId - | VTxOutIdW !V.TxOutId + = CTxOutIdW !VC.TxOutId + | VTxOutIdW !VA.TxOutId deriving (Show) --- TxOut fields for a given TxOutTableType -class (PersistEntity (TxOutTable a), PersistField (TxOutIdFor a)) => TxOutFields (a :: TxOutTableType) where +-- TxOut fields for a given TxOutVariantType +class (PersistEntity (TxOutTable a), PersistField (TxOutIdFor a)) => TxOutFields (a :: TxOutVariantType) where type TxOutTable a :: Type type TxOutIdFor a :: Type txOutIdField :: EntityField (TxOutTable a) (TxOutIdFor a) @@ -48,37 +48,37 @@ class (PersistEntity (TxOutTable a), PersistField (TxOutIdFor a)) => TxOutFields txOutReferenceScriptIdField :: EntityField (TxOutTable a) (Maybe ScriptId) txOutConsumedByTxIdField :: EntityField (TxOutTable a) (Maybe TxId) --- TxOutCore fields -instance TxOutFields 'TxOutCore where - type TxOutTable 'TxOutCore = C.TxOut - type TxOutIdFor 'TxOutCore = C.TxOutId - txOutTxIdField = C.TxOutTxId - txOutIndexField = C.TxOutIndex - txOutValueField = C.TxOutValue - txOutIdField = C.TxOutId - txOutDataHashField = C.TxOutDataHash - txOutInlineDatumIdField = C.TxOutInlineDatumId - txOutReferenceScriptIdField = C.TxOutReferenceScriptId - txOutConsumedByTxIdField = C.TxOutConsumedByTxId +-- TxOutVariantCore fields +instance TxOutFields 'TxOutVariantCore where + type TxOutTable 'TxOutVariantCore = VC.TxOut + type TxOutIdFor 'TxOutVariantCore = VC.TxOutId + txOutTxIdField = VC.TxOutTxId + txOutIndexField = VC.TxOutIndex + txOutValueField = VC.TxOutValue + txOutIdField = VC.TxOutId + txOutDataHashField = VC.TxOutDataHash + txOutInlineDatumIdField = VC.TxOutInlineDatumId + txOutReferenceScriptIdField = VC.TxOutReferenceScriptId + txOutConsumedByTxIdField = VC.TxOutConsumedByTxId -- TxOutVariantAddress fields instance TxOutFields 'TxOutVariantAddress where - type TxOutTable 'TxOutVariantAddress = V.TxOut - type TxOutIdFor 'TxOutVariantAddress = V.TxOutId - txOutTxIdField = V.TxOutTxId - txOutIndexField = V.TxOutIndex - txOutValueField = V.TxOutValue - txOutIdField = V.TxOutId - txOutDataHashField = V.TxOutDataHash - txOutInlineDatumIdField = V.TxOutInlineDatumId - txOutReferenceScriptIdField = V.TxOutReferenceScriptId - txOutConsumedByTxIdField = V.TxOutConsumedByTxId + type TxOutTable 'TxOutVariantAddress = VA.TxOut + type TxOutIdFor 'TxOutVariantAddress = VA.TxOutId + txOutTxIdField = VA.TxOutTxId + txOutIndexField = VA.TxOutIndex + txOutValueField = VA.TxOutValue + txOutIdField = VA.TxOutId + txOutDataHashField = VA.TxOutDataHash + txOutInlineDatumIdField = VA.TxOutInlineDatumId + txOutReferenceScriptIdField = VA.TxOutReferenceScriptId + txOutConsumedByTxIdField = VA.TxOutConsumedByTxId -------------------------------------------------------------------------------- -- Address -- related fields for TxOutVariantAddress only -------------------------------------------------------------------------------- -class AddressFields (a :: TxOutTableType) where +class AddressFields (a :: TxOutVariantType) where type AddressTable a :: Type type AddressIdFor a :: Type addressField :: EntityField (AddressTable a) Text @@ -90,14 +90,14 @@ class AddressFields (a :: TxOutTableType) where -- TxOutVariant fields instance AddressFields 'TxOutVariantAddress where - type AddressTable 'TxOutVariantAddress = V.Address - type AddressIdFor 'TxOutVariantAddress = V.AddressId - addressField = V.AddressAddress - addressRawField = V.AddressRaw - addressHasScriptField = V.AddressHasScript - addressPaymentCredField = V.AddressPaymentCred - addressStakeAddressIdField = V.AddressStakeAddressId - addressIdField = V.AddressId + type AddressTable 'TxOutVariantAddress = VA.Address + type AddressIdFor 'TxOutVariantAddress = VA.AddressId + addressField = VA.AddressAddress + addressRawField = VA.AddressRaw + addressHasScriptField = VA.AddressHasScript + addressPaymentCredField = VA.AddressPaymentCred + addressStakeAddressIdField = VA.AddressStakeAddressId + addressIdField = VA.AddressId -------------------------------------------------------------------------------- -- MaTxOut @@ -105,39 +105,39 @@ instance AddressFields 'TxOutVariantAddress where -- | A wrapper for MaTxOut data MaTxOutW - = CMaTxOutW !C.MaTxOut - | VMaTxOutW !V.MaTxOut + = CMaTxOutW !VC.MaTxOut + | VMaTxOutW !VA.MaTxOut deriving (Show) -- | A wrapper for MaTxOutId data MaTxOutIdW - = CMaTxOutIdW !C.MaTxOutId - | VMaTxOutIdW !V.MaTxOutId + = CMaTxOutIdW !VC.MaTxOutId + | VMaTxOutIdW !VA.MaTxOutId deriving (Show) --- MaTxOut fields for a given TxOutTableType -class PersistEntity (MaTxOutTable a) => MaTxOutFields (a :: TxOutTableType) where +-- MaTxOut fields for a given TxOutVariantType +class PersistEntity (MaTxOutTable a) => MaTxOutFields (a :: TxOutVariantType) where type MaTxOutTable a :: Type type MaTxOutIdFor a :: Type maTxOutTxOutIdField :: EntityField (MaTxOutTable a) (TxOutIdFor a) maTxOutIdentField :: EntityField (MaTxOutTable a) MultiAssetId maTxOutQuantityField :: EntityField (MaTxOutTable a) DbWord64 --- TxOutCore fields -instance MaTxOutFields 'TxOutCore where - type MaTxOutTable 'TxOutCore = C.MaTxOut - type MaTxOutIdFor 'TxOutCore = C.MaTxOutId - maTxOutTxOutIdField = C.MaTxOutTxOutId - maTxOutIdentField = C.MaTxOutIdent - maTxOutQuantityField = C.MaTxOutQuantity +-- TxOutVariantCore fields +instance MaTxOutFields 'TxOutVariantCore where + type MaTxOutTable 'TxOutVariantCore = VC.MaTxOut + type MaTxOutIdFor 'TxOutVariantCore = VC.MaTxOutId + maTxOutTxOutIdField = VC.MaTxOutTxOutId + maTxOutIdentField = VC.MaTxOutIdent + maTxOutQuantityField = VC.MaTxOutQuantity -- TxOutVariantAddress fields instance MaTxOutFields 'TxOutVariantAddress where - type MaTxOutTable 'TxOutVariantAddress = V.MaTxOut - type MaTxOutIdFor 'TxOutVariantAddress = V.MaTxOutId - maTxOutTxOutIdField = V.MaTxOutTxOutId - maTxOutIdentField = V.MaTxOutIdent - maTxOutQuantityField = V.MaTxOutQuantity + type MaTxOutTable 'TxOutVariantAddress = VA.MaTxOut + type MaTxOutIdFor 'TxOutVariantAddress = VA.MaTxOutId + maTxOutTxOutIdField = VA.MaTxOutTxOutId + maTxOutIdentField = VA.MaTxOutIdent + maTxOutQuantityField = VA.MaTxOutQuantity -- | UtxoQueryResult which has utxoAddress that can come from Core or Variant TxOut data UtxoQueryResult = UtxoQueryResult @@ -147,20 +147,20 @@ data UtxoQueryResult = UtxoQueryResult } -------------------------------------------------------------------------------- --- CollateralTxOut fields for a given TxOutTableType +-- CollateralTxOut fields for a given TxOutVariantType -------------------------------------------------------------------------------- data CollateralTxOutW - = CCollateralTxOutW !C.CollateralTxOut - | VCollateralTxOutW !V.CollateralTxOut + = CCollateralTxOutW !VC.CollateralTxOut + | VCollateralTxOutW !VA.CollateralTxOut deriving (Show) -- | A wrapper for TxOutId data CollateralTxOutIdW - = CCollateralTxOutIdW !C.CollateralTxOutId - | VCollateralTxOutIdW !V.CollateralTxOutId + = CCollateralTxOutIdW !VC.CollateralTxOutId + | VCollateralTxOutIdW !VA.CollateralTxOutId deriving (Show) -class PersistEntity (CollateralTxOutTable a) => CollateralTxOutFields (a :: TxOutTableType) where +class PersistEntity (CollateralTxOutTable a) => CollateralTxOutFields (a :: TxOutVariantType) where type CollateralTxOutTable a :: Type type CollateralTxOutIdFor a :: Type collateralTxOutIdField :: EntityField (CollateralTxOutTable a) (CollateralTxOutIdFor a) @@ -172,44 +172,44 @@ class PersistEntity (CollateralTxOutTable a) => CollateralTxOutFields (a :: TxOu -------------------------------------------------------------------------------- -- Helper functions -------------------------------------------------------------------------------- -extractCoreTxOut :: TxOutW -> C.TxOut +extractCoreTxOut :: TxOutW -> VC.TxOut extractCoreTxOut (CTxOutW txOut) = txOut -- this will never error as we can only have either CoreTxOut or VariantTxOut extractCoreTxOut (VTxOutW _ _) = error "Unexpected VTxOut in CoreTxOut list" -extractVariantTxOut :: TxOutW -> V.TxOut +extractVariantTxOut :: TxOutW -> VA.TxOut extractVariantTxOut (VTxOutW txOut _) = txOut -- this will never error as we can only have either CoreTxOut or VariantTxOut extractVariantTxOut (CTxOutW _) = error "Unexpected CTxOut in VariantTxOut list" -convertTxOutIdCore :: [TxOutIdW] -> [C.TxOutId] +convertTxOutIdCore :: [TxOutIdW] -> [VC.TxOutId] convertTxOutIdCore = mapMaybe unwrapCore where unwrapCore (CTxOutIdW txOutid) = Just txOutid unwrapCore _ = Nothing -convertTxOutIdVariant :: [TxOutIdW] -> [V.TxOutId] +convertTxOutIdVariant :: [TxOutIdW] -> [VA.TxOutId] convertTxOutIdVariant = mapMaybe unwrapVariant where unwrapVariant (VTxOutIdW txOutid) = Just txOutid unwrapVariant _ = Nothing -convertMaTxOutIdCore :: [MaTxOutIdW] -> [C.MaTxOutId] +convertMaTxOutIdCore :: [MaTxOutIdW] -> [VC.MaTxOutId] convertMaTxOutIdCore = mapMaybe unwrapCore where unwrapCore (CMaTxOutIdW maTxOutId) = Just maTxOutId unwrapCore _ = Nothing -convertMaTxOutIdVariant :: [MaTxOutIdW] -> [V.MaTxOutId] +convertMaTxOutIdVariant :: [MaTxOutIdW] -> [VA.MaTxOutId] convertMaTxOutIdVariant = mapMaybe unwrapVariant where unwrapVariant (VMaTxOutIdW maTxOutId) = Just maTxOutId unwrapVariant _ = Nothing -isTxOutCore :: TxOutTableType -> Bool -isTxOutCore TxOutCore = True -isTxOutCore TxOutVariantAddress = False +isTxOutVariantCore :: TxOutVariantType -> Bool +isTxOutVariantCore TxOutVariantCore = True +isTxOutVariantCore TxOutVariantAddress = False -isTxOutVariantAddress :: TxOutTableType -> Bool +isTxOutVariantAddress :: TxOutVariantType -> Bool isTxOutVariantAddress TxOutVariantAddress = True -isTxOutVariantAddress TxOutCore = False +isTxOutVariantAddress TxOutVariantCore = False diff --git a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Variants/TxOutAddress.hs similarity index 99% rename from cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs rename to cardano-db/src/Cardano/Db/Schema/Variants/TxOutAddress.hs index e27808df3..c4134d869 100644 --- a/cardano-db/src/Cardano/Db/Schema/Variant/TxOut.hs +++ b/cardano-db/src/Cardano/Db/Schema/Variants/TxOutAddress.hs @@ -15,7 +15,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Cardano.Db.Schema.Variant.TxOut where +module Cardano.Db.Schema.Variants.TxOutAddress where import Cardano.Db.Schema.BaseSchema (DatumId, MultiAssetId, ScriptId, StakeAddressId, TxId) import Cardano.Db.Types (DbLovelace, DbWord64) diff --git a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs b/cardano-db/src/Cardano/Db/Schema/Variants/TxOutCore.hs similarity index 96% rename from cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs rename to cardano-db/src/Cardano/Db/Schema/Variants/TxOutCore.hs index fd3ef67f1..335c3a44a 100644 --- a/cardano-db/src/Cardano/Db/Schema/Core/TxOut.hs +++ b/cardano-db/src/Cardano/Db/Schema/Variants/TxOutCore.hs @@ -15,7 +15,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Cardano.Db.Schema.Core.TxOut where +module Cardano.Db.Schema.Variants.TxOutCore where import Cardano.Db.Schema.BaseSchema (DatumId, MultiAssetId, ScriptId, StakeAddressId, TxId) import Cardano.Db.Types (DbLovelace, DbWord64) @@ -29,7 +29,7 @@ import Database.Persist.TH share [ mkPersist sqlSettings , mkMigrate "migrateCoreTxOutCardanoDb" - , mkEntityDefList "entityDefsTxOutCore" + , mkEntityDefList "entityDefsTxOutVariantCore" , deriveShowFields ] [persistLowerCase| @@ -78,9 +78,9 @@ share |] -schemaDocsTxOutCore :: [EntityDef] -schemaDocsTxOutCore = - document entityDefsTxOutCore $ do +schemaDocsTxOutVariantCore :: [EntityDef] +schemaDocsTxOutVariantCore = + document entityDefsTxOutVariantCore $ do TxOut --^ do "A table for transaction outputs." TxOutAddress # "The human readable encoding of the output address. Will be Base58 for Byron era addresses and Bech32 for Shelley era." diff --git a/cardano-db/test/Test/IO/Cardano/Db/Insert.hs b/cardano-db/test/Test/IO/Cardano/Db/Insert.hs index 233a4400c..f67cb6f8e 100644 --- a/cardano-db/test/Test/IO/Cardano/Db/Insert.hs +++ b/cardano-db/test/Test/IO/Cardano/Db/Insert.hs @@ -31,8 +31,8 @@ insertZeroTest = deleteAllBlocks -- Delete the blocks if they exist. slid <- insertSlotLeader testSlotLeader - void $ deleteBlock TxOutCore (blockOne slid) - void $ deleteBlock TxOutCore (blockZero slid) + void $ deleteBlock TxOutVariantCore (blockOne slid) + void $ deleteBlock TxOutVariantCore (blockZero slid) -- Insert the same block twice. The first should be successful (resulting -- in a 'Right') and the second should return the same value in a 'Left'. bid0 <- insertBlockChecked (blockZero slid) @@ -45,7 +45,7 @@ insertFirstTest = deleteAllBlocks -- Delete the block if it exists. slid <- insertSlotLeader testSlotLeader - void $ deleteBlock TxOutCore (blockOne slid) + void $ deleteBlock TxOutVariantCore (blockOne slid) -- Insert the same block twice. bid0 <- insertBlockChecked (blockZero slid) bid1 <- insertBlockChecked $ (\b -> b {blockPreviousId = Just bid0}) (blockOne slid) diff --git a/cardano-db/test/Test/IO/Cardano/Db/Migration.hs b/cardano-db/test/Test/IO/Cardano/Db/Migration.hs index 640b68a45..0e24a6854 100644 --- a/cardano-db/test/Test/IO/Cardano/Db/Migration.hs +++ b/cardano-db/test/Test/IO/Cardano/Db/Migration.hs @@ -12,7 +12,7 @@ import Cardano.Db ( MigrationValidateError (..), MigrationVersion (..), SchemaVersion (..), - TxOutTableType (..), + TxOutVariantType (..), getMigrationScripts, querySchemaVersion, readPGPassDefault, diff --git a/cardano-db/test/Test/IO/Cardano/Db/Rollback.hs b/cardano-db/test/Test/IO/Cardano/Db/Rollback.hs index b4133bd92..4632a0986 100644 --- a/cardano-db/test/Test/IO/Cardano/Db/Rollback.hs +++ b/cardano-db/test/Test/IO/Cardano/Db/Rollback.hs @@ -44,20 +44,20 @@ _rollbackTest = assertBool ("Block count before rollback is " ++ show beforeBlocks ++ " but should be 10.") $ beforeBlocks == 10 beforeTxCount <- queryTxCount assertBool ("Tx count before rollback is " ++ show beforeTxCount ++ " but should be 9.") $ beforeTxCount == 9 - beforeTxOutCount <- queryTxOutCount TxOutCore + beforeTxOutCount <- queryTxOutCount TxOutVariantCore assertBool ("TxOut count before rollback is " ++ show beforeTxOutCount ++ " but should be 2.") $ beforeTxOutCount == 2 beforeTxInCount <- queryTxInCount assertBool ("TxIn count before rollback is " ++ show beforeTxInCount ++ " but should be 1.") $ beforeTxInCount == 1 -- Rollback a set of blocks. latestSlotNo <- queryLatestSlotNo Just pSlotNo <- queryWalkChain 5 latestSlotNo - void $ deleteBlocksSlotNoNoTrace TxOutCore (SlotNo pSlotNo) + void $ deleteBlocksSlotNoNoTrace TxOutVariantCore (SlotNo pSlotNo) -- Assert the expected final state. afterBlocks <- queryBlockCount assertBool ("Block count after rollback is " ++ show afterBlocks ++ " but should be 10") $ afterBlocks == 4 afterTxCount <- queryTxCount assertBool ("Tx count after rollback is " ++ show afterTxCount ++ " but should be 10") $ afterTxCount == 1 - afterTxOutCount <- queryTxOutCount TxOutCore + afterTxOutCount <- queryTxOutCount TxOutVariantCore assertBool ("TxOut count after rollback is " ++ show afterTxOutCount ++ " but should be 1.") $ afterTxOutCount == 1 afterTxInCount <- queryTxInCount assertBool ("TxIn count after rollback is " ++ show afterTxInCount ++ " but should be 0.") $ afterTxInCount == 0 @@ -132,7 +132,7 @@ createAndInsertBlocks blockCount = 0 (DbLovelace 0) - void $ insertTxOut (mkTxOutCore blkId txId) + void $ insertTxOut (mkTxOutVariantCore blkId txId) pure $ Just txId case (indx, mTxOutId) of (8, Just txOutId) -> do @@ -141,6 +141,6 @@ createAndInsertBlocks blockCount = txId <- head <$> mapM insertTx (mkTxs blkId 8) void $ insertTxIn (TxIn txId txOutId 0 Nothing) - void $ insertTxOut (mkTxOutCore blkId txId) + void $ insertTxOut (mkTxOutVariantCore blkId txId) _otherwise -> pure () pure (indx + 1, Just blkId, newMTxOutId) diff --git a/cardano-db/test/Test/IO/Cardano/Db/TotalSupply.hs b/cardano-db/test/Test/IO/Cardano/Db/TotalSupply.hs index 0a7ac3dc4..7710bf004 100644 --- a/cardano-db/test/Test/IO/Cardano/Db/TotalSupply.hs +++ b/cardano-db/test/Test/IO/Cardano/Db/TotalSupply.hs @@ -12,7 +12,7 @@ module Test.IO.Cardano.Db.TotalSupply ( ) where import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import qualified Data.Text as Text import Test.IO.Cardano.Db.Util import Test.Tasty (TestTree, testGroup) @@ -35,10 +35,10 @@ initialSupplyTest = slid <- insertSlotLeader testSlotLeader bid0 <- insertBlock (mkBlock 0 slid) (tx0Ids :: [TxId]) <- mapM insertTx $ mkTxs bid0 4 - mapM_ (insertTxOut . mkTxOutCore bid0) tx0Ids + mapM_ (insertTxOut . mkTxOutVariantCore bid0) tx0Ids count <- queryBlockCount assertBool ("Block count should be 1, got " ++ show count) (count == 1) - supply0 <- queryTotalSupply TxOutCore + supply0 <- queryTotalSupply TxOutVariantCore assertBool "Total supply should not be > 0" (supply0 > Ada 0) -- Spend from the Utxo set. @@ -64,18 +64,18 @@ initialSupplyTest = _ <- insertTxOut $ CTxOutW $ - C.TxOut - { C.txOutTxId = tx1Id - , C.txOutIndex = 0 - , C.txOutAddress = Text.pack addr - , C.txOutAddressHasScript = False - , C.txOutPaymentCred = Nothing - , C.txOutStakeAddressId = Nothing - , C.txOutValue = DbLovelace 500000000 - , C.txOutDataHash = Nothing - , C.txOutInlineDatumId = Nothing - , C.txOutReferenceScriptId = Nothing - , C.txOutConsumedByTxId = Nothing + VC.TxOut + { VC.txOutTxId = tx1Id + , VC.txOutIndex = 0 + , VC.txOutAddress = Text.pack addr + , VC.txOutAddressHasScript = False + , VC.txOutPaymentCred = Nothing + , VC.txOutStakeAddressId = Nothing + , VC.txOutValue = DbLovelace 500000000 + , VC.txOutDataHash = Nothing + , VC.txOutInlineDatumId = Nothing + , VC.txOutReferenceScriptId = Nothing + , VC.txOutConsumedByTxId = Nothing } - supply1 <- queryTotalSupply TxOutCore + supply1 <- queryTotalSupply TxOutVariantCore assertBool ("Total supply should be < " ++ show supply0) (supply1 < supply0) diff --git a/cardano-db/test/Test/IO/Cardano/Db/Util.hs b/cardano-db/test/Test/IO/Cardano/Db/Util.hs index 1bf6cece7..f3e47f930 100644 --- a/cardano-db/test/Test/IO/Cardano/Db/Util.hs +++ b/cardano-db/test/Test/IO/Cardano/Db/Util.hs @@ -10,12 +10,12 @@ module Test.IO.Cardano.Db.Util ( mkBlockHash, mkTxHash, mkTxs, - mkTxOutCore, + mkTxOutVariantCore, testSlotLeader, ) where import Cardano.Db -import qualified Cardano.Db.Schema.Core.TxOut as C +import qualified Cardano.Db.Schema.Variants.TxOutCore as VC import Control.Monad (unless) import Control.Monad.Extra (whenJust) import Control.Monad.IO.Class (MonadIO, liftIO) @@ -36,7 +36,7 @@ assertBool msg bool = deleteAllBlocks :: MonadIO m => ReaderT SqlBackend m () deleteAllBlocks = do mblkId <- queryMinBlock - whenJust mblkId $ uncurry (deleteBlocksForTests TxOutCore) + whenJust mblkId $ uncurry (deleteBlocksForTests TxOutVariantCore) dummyUTCTime :: UTCTime dummyUTCTime = UTCTime (ModifiedJulianDay 0) 0 @@ -97,20 +97,20 @@ testSlotLeader :: SlotLeader testSlotLeader = SlotLeader (BS.pack . take 28 $ "test slot leader" ++ replicate 28 ' ') Nothing "Dummy test slot leader" -mkTxOutCore :: BlockId -> TxId -> TxOutW -mkTxOutCore blkId txId = +mkTxOutVariantCore :: BlockId -> TxId -> TxOutW +mkTxOutVariantCore blkId txId = let addr = mkAddressHash blkId txId in CTxOutW $ - C.TxOut - { C.txOutAddress = Text.pack addr - , C.txOutAddressHasScript = False - , C.txOutConsumedByTxId = Nothing - , C.txOutDataHash = Nothing - , C.txOutIndex = 0 - , C.txOutInlineDatumId = Nothing - , C.txOutPaymentCred = Nothing - , C.txOutReferenceScriptId = Nothing - , C.txOutStakeAddressId = Nothing - , C.txOutTxId = txId - , C.txOutValue = DbLovelace 1000000000 + VC.TxOut + { VC.txOutAddress = Text.pack addr + , VC.txOutAddressHasScript = False + , VC.txOutConsumedByTxId = Nothing + , VC.txOutDataHash = Nothing + , VC.txOutIndex = 0 + , VC.txOutInlineDatumId = Nothing + , VC.txOutPaymentCred = Nothing + , VC.txOutReferenceScriptId = Nothing + , VC.txOutStakeAddressId = Nothing + , VC.txOutTxId = txId + , VC.txOutValue = DbLovelace 1000000000 }