Skip to content

Commit f1bb0df

Browse files
CmdvCmdv
committed
add lots more queries and deletes
1 parent 8ad42f6 commit f1bb0df

File tree

27 files changed

+4695
-1382
lines changed

27 files changed

+4695
-1382
lines changed

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -205,7 +205,7 @@ assertCurrentEpoch :: DBSyncEnv -> Word64 -> IO ()
205205
assertCurrentEpoch env expected =
206206
assertEqBackoff env q (Just expected) defaultDelays "Unexpected epoch stake counts"
207207
where
208-
q = queryCurrentEpochNo
208+
q = queryBlocksForCurrentEpochNo
209209

210210
assertAddrValues ::
211211
(EraCrypto era ~ StandardCrypto, Core.EraTxOut era) =>

‎cardano-db-sync/src/Cardano/DbSync/Era/Universal/Insert/Other.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@ insertScript ::
188188
Generic.TxScript ->
189189
ReaderT SqlBackend m DB.ScriptId
190190
insertScript tracer txId script = do
191-
mScriptId <- DB.queryScript $ Generic.txScriptHash script
191+
mScriptId <- DB.queryScriptWithId $ Generic.txScriptHash script
192192
case mScriptId of
193193
Just scriptId -> pure scriptId
194194
Nothing -> do

‎cardano-db-tool/src/Cardano/DbTool/Report/Balance.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ queryStakeAddressBalance txOutTableType address = do
114114

115115
queryRewardsSum :: MonadIO m => StakeAddressId -> ReaderT SqlBackend m Ada
116116
queryRewardsSum saId = do
117-
currentEpoch <- queryLatestEpochNo
117+
currentEpoch <- queryLatestEpochNoFromBlock
118118
res <- select $ do
119119
rwd <- from $ table @Reward
120120
where_ (rwd ^. RewardAddrId ==. val saId)

‎cardano-db/cardano-db.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@ library
6161
Cardano.Db.Schema.Core.Pool
6262
Cardano.Db.Schema.Core.StakeDeligation
6363
Cardano.Db.Schema.Ids
64+
Cardano.Db.Schema.MinIds
6465
Cardano.Db.Schema.Orphans
6566
Cardano.Db.Schema.Types
6667
Cardano.Db.Schema.Variants.TxOutAddress
@@ -78,6 +79,7 @@ library
7879
Cardano.Db.Statement.MultiAsset
7980
Cardano.Db.Statement.OffChain
8081
Cardano.Db.Statement.Pool
82+
Cardano.Db.Statement.Rollback
8183
Cardano.Db.Statement.StakeDeligation
8284
Cardano.Db.Statement.Types
8385
Cardano.Db.Statement.Variants.TxOut

‎cardano-db/src/Cardano/Db/Operations/Delete.hs

Lines changed: 18 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -59,24 +59,24 @@ import Cardano.Slotting.Slot ()
5959

6060
-- | Delete a block if it exists. Returns 'True' if it did exist and has been
6161
-- deleted and 'False' if it did not exist.
62-
deleteBlocksSlotNo ::
63-
MonadIO m =>
64-
Trace IO Text ->
65-
TxOutTableType ->
66-
SlotNo ->
67-
Bool ->
68-
ReaderT SqlBackend m Bool
69-
deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
70-
mBlockId <- queryNearestBlockSlotNo slotNo
71-
case mBlockId of
72-
Nothing -> do
73-
liftIO $ logWarning trce $ "deleteBlocksSlotNo: No block contains the the slot: " <> pack (show slotNo)
74-
pure False
75-
Just (blockId, epochN) -> do
76-
void $ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut
77-
pure True
62+
-- deleteBlocksSlotNo ::
63+
-- MonadIO m =>
64+
-- Trace IO Text ->
65+
-- TxOutTableType ->
66+
-- SlotNo ->
67+
-- Bool ->
68+
-- ReaderT SqlBackend m Bool
69+
-- deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
70+
-- mBlockId <- queryNearestBlockSlotNo slotNo
71+
-- case mBlockId of
72+
-- Nothing -> do
73+
-- liftIO $ logWarning trce $ "deleteBlocksSlotNo: No block contains the the slot: " <> pack (show slotNo)
74+
-- pure False
75+
-- Just (blockId, epochN) -> do
76+
-- void $ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut
77+
-- pure True
7878

79-
-- -- | Delete starting from a 'BlockId'.
79+
-- | Delete starting from a 'BlockId'.
8080
-- deleteBlocksBlockId ::
8181
-- MonadIO m =>
8282
-- Trace IO Text ->
@@ -140,6 +140,7 @@ deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
140140
-- pure [("GovActionProposal Nulled", a + b + c + e)]
141141
-- pure $ countLogs <> nullLogs
142142

143+
-- TODO: CMDV
143144
-- deleteTablesAfterBlockId ::
144145
-- MonadIO m =>
145146
-- TxOutTableType ->
@@ -319,16 +320,6 @@ deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
319320
-- count <- deleteWhereCount [persistIdField @record >=. recordId]
320321
-- pure [(tableName, count)]
321322

322-
-- onlyDelete ::
323-
-- forall m record.
324-
-- (MonadIO m, PersistEntity record, PersistEntityBackend record ~ SqlBackend) =>
325-
-- Text ->
326-
-- [Filter record] ->
327-
-- ReaderT SqlBackend m [(Text, Int64)]
328-
-- onlyDelete tableName filters = do
329-
-- count <- deleteWhereCount filters
330-
-- pure [(tableName, count)]
331-
332323
-- queryThenNull ::
333324
-- forall m record field.
334325
-- (MonadIO m, PersistEntity record, PersistField field, PersistEntityBackend record ~ SqlBackend) =>

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

Lines changed: 68 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -104,74 +104,74 @@ module Cardano.Db.Operations.Other.ConsumedTxOut where
104104
-- CTxOutIdW txOutId' -> update txOutId' [C.TxOutConsumedByTxId =. Nothing]
105105
-- VTxOutIdW txOutId' -> update txOutId' [V.TxOutConsumedByTxId =. Nothing]
106106

107-
-- runExtraMigrations :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> TxOutTableType -> Word64 -> PruneConsumeMigration -> ReaderT SqlBackend m ()
108-
-- runExtraMigrations trce txOutTableType blockNoDiff pcm = do
109-
-- ems <- queryAllExtraMigrations
110-
-- isTxOutNull <- queryTxOutIsNull txOutTableType
111-
-- let migrationValues = processMigrationValues ems pcm
112-
-- isTxOutVariant = isTxOutVariantAddress txOutTableType
113-
-- isTxOutAddressSet = isTxOutAddressPreviouslySet migrationValues
114-
115-
-- -- can only run "use_address_table" on a non populated database but don't throw if the migration was previously set
116-
-- when (isTxOutVariant && not isTxOutNull && not isTxOutAddressSet) $
117-
-- throw $
118-
-- DBExtraMigration "runExtraMigrations: The use of the config 'tx_out.use_address_table' can only be caried out on a non populated database."
119-
-- -- Make sure the config "use_address_table" is there if the migration wasn't previously set in the past
120-
-- when (not isTxOutVariant && isTxOutAddressSet) $
121-
-- throw $
122-
-- DBExtraMigration "runExtraMigrations: The configuration option 'tx_out.use_address_table' was previously set and the database updated. Unfortunately reverting this isn't possible."
123-
-- -- Has the user given txout address config && the migration wasn't previously set
124-
-- when (isTxOutVariant && not isTxOutAddressSet) $ do
125-
-- updateTxOutAndCreateAddress trce
126-
-- insertExtraMigration TxOutAddressPreviouslySet
127-
-- -- first check if pruneTxOut flag is missing and it has previously been used
128-
-- when (isPruneTxOutPreviouslySet migrationValues && not (pcmPruneTxOut pcm)) $
129-
-- throw $
130-
-- DBExtraMigration
131-
-- "If --prune-tx-out flag is enabled and then db-sync is stopped all future executions of db-sync should still have this flag activated. Otherwise, it is considered bad usage and can cause crashes."
132-
-- handleMigration migrationValues
133-
-- where
134-
-- handleMigration :: (MonadBaseControl IO m, MonadIO m) => MigrationValues -> ReaderT SqlBackend m ()
135-
-- handleMigration migrationValues@MigrationValues {..} = do
136-
-- let PruneConsumeMigration {..} = pruneConsumeMigration
137-
-- case (isConsumeTxOutPreviouslySet, pcmConsumedTxOut, pcmPruneTxOut) of
138-
-- -- No Migration Needed
139-
-- (False, False, False) -> do
140-
-- liftIO $ logInfo trce "runExtraMigrations: No extra migration specified"
141-
-- -- Already migrated
142-
-- (True, True, False) -> do
143-
-- liftIO $ logInfo trce "runExtraMigrations: Extra migration consumed_tx_out already executed"
144-
-- -- Invalid State
145-
-- (True, False, False) -> liftIO $ logAndThrowIO trce "runExtraMigrations: consumed-tx-out or prune-tx-out is not set, but consumed migration is found."
146-
-- -- Consume TxOut
147-
-- (False, True, False) -> do
148-
-- liftIO $ logInfo trce "runExtraMigrations: Running extra migration consumed_tx_out"
149-
-- insertExtraMigration ConsumeTxOutPreviouslySet
150-
-- migrateTxOut trce txOutTableType $ Just migrationValues
151-
-- -- Prune TxOut
152-
-- (_, _, True) -> do
153-
-- unless isPruneTxOutPreviouslySet $ insertExtraMigration PruneTxOutFlagPreviouslySet
154-
-- if isConsumeTxOutPreviouslySet
155-
-- then do
156-
-- liftIO $ logInfo trce "runExtraMigrations: Running extra migration prune tx_out"
157-
-- deleteConsumedTxOut trce txOutTableType blockNoDiff
158-
-- else deleteAndUpdateConsumedTxOut trce txOutTableType migrationValues blockNoDiff
159-
160-
-- queryWrongConsumedBy :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64
161-
-- queryWrongConsumedBy = \case
162-
-- TxOutCore -> query @'TxOutCore
163-
-- TxOutVariantAddress -> query @'TxOutVariantAddress
164-
-- where
165-
-- query ::
166-
-- forall (a :: TxOutTableType) m.
167-
-- (MonadIO m, TxOutFields a) =>
168-
-- ReaderT SqlBackend m Word64
169-
-- query = do
170-
-- res <- select $ do
171-
-- txOut <- from $ table @(TxOutTable a)
172-
-- where_ (just (txOut ^. txOutTxIdField @a) E.==. txOut ^. txOutConsumedByTxIdField @a)
173-
-- pure countRows
174-
-- pure $ maybe 0 unValue (listToMaybe res)
107+
runExtraMigrations :: (MonadBaseControl IO m, MonadIO m) => Trace IO Text -> TxOutTableType -> Word64 -> PruneConsumeMigration -> ReaderT SqlBackend m ()
108+
runExtraMigrations trce txOutTableType blockNoDiff pcm = do
109+
ems <- queryAllExtraMigrations
110+
isTxOutNull <- queryTxOutIsNull txOutTableType
111+
let migrationValues = processMigrationValues ems pcm
112+
isTxOutVariant = isTxOutVariantAddress txOutTableType
113+
isTxOutAddressSet = isTxOutAddressPreviouslySet migrationValues
114+
115+
-- can only run "use_address_table" on a non populated database but don't throw if the migration was previously set
116+
when (isTxOutVariant && not isTxOutNull && not isTxOutAddressSet) $
117+
throw $
118+
DBExtraMigration "runExtraMigrations: The use of the config 'tx_out.use_address_table' can only be caried out on a non populated database."
119+
-- Make sure the config "use_address_table" is there if the migration wasn't previously set in the past
120+
when (not isTxOutVariant && isTxOutAddressSet) $
121+
throw $
122+
DBExtraMigration "runExtraMigrations: The configuration option 'tx_out.use_address_table' was previously set and the database updated. Unfortunately reverting this isn't possible."
123+
-- Has the user given txout address config && the migration wasn't previously set
124+
when (isTxOutVariant && not isTxOutAddressSet) $ do
125+
updateTxOutAndCreateAddress trce
126+
insertExtraMigration TxOutAddressPreviouslySet
127+
-- first check if pruneTxOut flag is missing and it has previously been used
128+
when (isPruneTxOutPreviouslySet migrationValues && not (pcmPruneTxOut pcm)) $
129+
throw $
130+
DBExtraMigration
131+
"If --prune-tx-out flag is enabled and then db-sync is stopped all future executions of db-sync should still have this flag activated. Otherwise, it is considered bad usage and can cause crashes."
132+
handleMigration migrationValues
133+
where
134+
handleMigration :: (MonadBaseControl IO m, MonadIO m) => MigrationValues -> ReaderT SqlBackend m ()
135+
handleMigration migrationValues@MigrationValues {..} = do
136+
let PruneConsumeMigration {..} = pruneConsumeMigration
137+
case (isConsumeTxOutPreviouslySet, pcmConsumedTxOut, pcmPruneTxOut) of
138+
-- No Migration Needed
139+
(False, False, False) -> do
140+
liftIO $ logInfo trce "runExtraMigrations: No extra migration specified"
141+
-- Already migrated
142+
(True, True, False) -> do
143+
liftIO $ logInfo trce "runExtraMigrations: Extra migration consumed_tx_out already executed"
144+
-- Invalid State
145+
(True, False, False) -> liftIO $ logAndThrowIO trce "runExtraMigrations: consumed-tx-out or prune-tx-out is not set, but consumed migration is found."
146+
-- Consume TxOut
147+
(False, True, False) -> do
148+
liftIO $ logInfo trce "runExtraMigrations: Running extra migration consumed_tx_out"
149+
insertExtraMigration ConsumeTxOutPreviouslySet
150+
migrateTxOut trce txOutTableType $ Just migrationValues
151+
-- Prune TxOut
152+
(_, _, True) -> do
153+
unless isPruneTxOutPreviouslySet $ insertExtraMigration PruneTxOutFlagPreviouslySet
154+
if isConsumeTxOutPreviouslySet
155+
then do
156+
liftIO $ logInfo trce "runExtraMigrations: Running extra migration prune tx_out"
157+
deleteConsumedTxOut trce txOutTableType blockNoDiff
158+
else deleteAndUpdateConsumedTxOut trce txOutTableType migrationValues blockNoDiff
159+
160+
queryWrongConsumedBy :: TxOutTableType -> MonadIO m => ReaderT SqlBackend m Word64
161+
queryWrongConsumedBy = \case
162+
TxOutCore -> query @'TxOutCore
163+
TxOutVariantAddress -> query @'TxOutVariantAddress
164+
where
165+
query ::
166+
forall (a :: TxOutTableType) m.
167+
(MonadIO m, TxOutFields a) =>
168+
ReaderT SqlBackend m Word64
169+
query = do
170+
res <- select $ do
171+
txOut <- from $ table @(TxOutTable a)
172+
where_ (just (txOut ^. txOutTxIdField @a) E.==. txOut ^. txOutConsumedByTxIdField @a)
173+
pure countRows
174+
pure $ maybe 0 unValue (listToMaybe res)
175175

176176
-- --------------------------------------------------------------------------------------------------
177177
-- -- Queries Tests

‎cardano-db/src/Cardano/Db/Operations/Other/MinId.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -104,9 +104,9 @@ module Cardano.Db.Operations.Other.MinId where
104104
-- minJust x Nothing = x
105105
-- minJust (Just x) (Just y) = Just (min x y)
106106

107-
-- --------------------------------------------------------------------------------
108-
-- -- CompleteMinId
109-
-- --------------------------------------------------------------------------------
107+
--------------------------------------------------------------------------------
108+
-- CompleteMinId
109+
--------------------------------------------------------------------------------
110110
-- completeMinId ::
111111
-- (MonadIO m) =>
112112
-- Maybe TxId ->

0 commit comments

Comments
 (0)