9
9
{-# LANGUAGE TypeOperators #-}
10
10
11
11
module Cardano.Db.Operations.Delete (
12
- deleteBlocksSlotNo ,
13
- deleteBlocksSlotNoNoTrace ,
14
12
deleteDelistedPool ,
15
13
deleteBlocksBlockId ,
14
+ queryDelete ,
15
+ deleteBlocksSlotNo ,
16
+ deleteBlocksSlotNoNoTrace ,
16
17
deleteBlocksForTests ,
17
18
deleteBlock ,
18
- queryDelete ,
19
19
) where
20
20
21
21
import Cardano.BM.Trace (Trace , logInfo , logWarning , nullTracer )
@@ -54,32 +54,25 @@ import Database.Persist (
54
54
)
55
55
import Database.Persist.Sql (Filter , SqlBackend , delete , deleteWhere , deleteWhereCount , selectKeysList )
56
56
57
- deleteBlocksSlotNoNoTrace :: MonadIO m => TxOutTableType -> SlotNo -> ReaderT SqlBackend m Bool
58
- deleteBlocksSlotNoNoTrace txOutTableType slotNo = deleteBlocksSlotNo nullTracer txOutTableType slotNo Nothing
59
-
60
57
-- | Delete a block if it exists. Returns 'True' if it did exist and has been
61
58
-- deleted and 'False' if it did not exist.
62
59
deleteBlocksSlotNo ::
63
60
MonadIO m =>
64
61
Trace IO Text ->
65
62
TxOutTableType ->
66
63
SlotNo ->
67
- Maybe Bool ->
64
+ Bool ->
68
65
ReaderT SqlBackend m Bool
69
- deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) mIsConsumedTxOut = do
66
+ deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
70
67
mBlockId <- queryNearestBlockSlotNo slotNo
71
68
case mBlockId of
72
69
Nothing -> do
73
70
liftIO $ logWarning trce $ " deleteBlocksSlotNo: No block contains the the slot: " <> pack (show slotNo)
74
71
pure False
75
72
Just (blockId, epochN) -> do
76
- void $ deleteBlocksBlockId trce txOutTableType blockId epochN mIsConsumedTxOut
73
+ void $ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut
77
74
pure True
78
75
79
- deleteBlocksForTests :: MonadIO m => TxOutTableType -> BlockId -> Word64 -> ReaderT SqlBackend m ()
80
- deleteBlocksForTests txOutTableType blockId epochN = do
81
- void $ deleteBlocksBlockId nullTracer txOutTableType blockId epochN Nothing
82
-
83
76
-- | Delete starting from a 'BlockId'.
84
77
deleteBlocksBlockId ::
85
78
MonadIO m =>
@@ -89,20 +82,19 @@ deleteBlocksBlockId ::
89
82
-- | The 'EpochNo' of the block to delete.
90
83
Word64 ->
91
84
-- | Is ConsumeTxout
92
- Maybe Bool ->
85
+ Bool ->
93
86
ReaderT SqlBackend m Int64
94
- deleteBlocksBlockId trce txOutTableType blockId epochN mIsConsumedTxOut = do
87
+ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut = do
95
88
mMinIds <- fmap (textToMinIds txOutTableType =<< ) <$> queryReverseIndexBlockId blockId
96
89
(cminIds, completed) <- findMinIdsRec mMinIds mempty
97
90
mTxId <- queryMinRefId TxBlockId blockId
98
91
minIds <- if completed then pure cminIds else completeMinId mTxId cminIds
99
92
deleteEpochLogs <- deleteUsingEpochNo epochN
100
93
(deleteBlockCount, blockDeleteLogs) <- deleteTablesAfterBlockId txOutTableType blockId mTxId minIds
101
94
setNullLogs <-
102
- maybe
103
- (pure (" ConsumedTxOut is not active so no Nulls set" , 0 ))
104
- (\ _ -> querySetNullTxOut txOutTableType mTxId)
105
- mIsConsumedTxOut
95
+ if isConsumedTxOut
96
+ then querySetNullTxOut txOutTableType mTxId
97
+ else pure (" ConsumedTxOut is not active so no Nulls set" , 0 )
106
98
-- log all the deleted rows in the rollback
107
99
liftIO $ logInfo trce $ mkRollbackSummary (deleteEpochLogs <> blockDeleteLogs) setNullLogs
108
100
pure deleteBlockCount
@@ -357,17 +349,6 @@ deleteDelistedPool poolHash = do
357
349
mapM_ delete keys
358
350
pure $ not (null keys)
359
351
360
- -- | Delete a block if it exists. Returns 'True' if it did exist and has been
361
- -- deleted and 'False' if it did not exist.
362
- deleteBlock :: MonadIO m => TxOutTableType -> Block -> ReaderT SqlBackend m Bool
363
- deleteBlock txOutTableType block = do
364
- mBlockId <- queryBlockHash block
365
- case mBlockId of
366
- Nothing -> pure False
367
- Just (blockId, epochN) -> do
368
- void $ deleteBlocksBlockId nullTracer txOutTableType blockId epochN Nothing
369
- pure True
370
-
371
352
mkRollbackSummary :: [(Text , Int64 )] -> (Text , Int64 ) -> Text
372
353
mkRollbackSummary logs setNullLogs =
373
354
" \n ----------------------- Rollback Summary: ----------------------- \n "
@@ -392,3 +373,25 @@ mkRollbackSummary logs setNullLogs =
392
373
<> if nullCount == 0
393
374
then nullMessage
394
375
else " \n\n Set Null: " <> nullMessage <> " - Count: " <> pack (show nullCount)
376
+
377
+ -- Tools
378
+
379
+ deleteBlocksSlotNoNoTrace :: MonadIO m => TxOutTableType -> SlotNo -> ReaderT SqlBackend m Bool
380
+ deleteBlocksSlotNoNoTrace txOutTableType slotNo = deleteBlocksSlotNo nullTracer txOutTableType slotNo True
381
+
382
+ -- Tests
383
+
384
+ deleteBlocksForTests :: MonadIO m => TxOutTableType -> BlockId -> Word64 -> ReaderT SqlBackend m ()
385
+ deleteBlocksForTests txOutTableType blockId epochN = do
386
+ void $ deleteBlocksBlockId nullTracer txOutTableType blockId epochN False
387
+
388
+ -- | Delete a block if it exists. Returns 'True' if it did exist and has been
389
+ -- deleted and 'False' if it did not exist.
390
+ deleteBlock :: MonadIO m => TxOutTableType -> Block -> ReaderT SqlBackend m Bool
391
+ deleteBlock txOutTableType block = do
392
+ mBlockId <- queryBlockHash block
393
+ case mBlockId of
394
+ Nothing -> pure False
395
+ Just (blockId, epochN) -> do
396
+ void $ deleteBlocksBlockId nullTracer txOutTableType blockId epochN False
397
+ pure True
0 commit comments