99{-# LANGUAGE TypeOperators #-}
1010
1111module Cardano.Db.Operations.Delete (
12- deleteBlocksSlotNo ,
13- deleteBlocksSlotNoNoTrace ,
1412 deleteDelistedPool ,
1513 deleteBlocksBlockId ,
14+ queryDelete ,
15+ deleteBlocksSlotNo ,
16+ deleteBlocksSlotNoNoTrace ,
1617 deleteBlocksForTests ,
1718 deleteBlock ,
18- queryDelete ,
1919) where
2020
2121import Cardano.BM.Trace (Trace , logInfo , logWarning , nullTracer )
@@ -54,32 +54,25 @@ import Database.Persist (
5454 )
5555import Database.Persist.Sql (Filter , SqlBackend , delete , deleteWhere , deleteWhereCount , selectKeysList )
5656
57- deleteBlocksSlotNoNoTrace :: MonadIO m => TxOutTableType -> SlotNo -> ReaderT SqlBackend m Bool
58- deleteBlocksSlotNoNoTrace txOutTableType slotNo = deleteBlocksSlotNo nullTracer txOutTableType slotNo Nothing
59-
6057-- | Delete a block if it exists. Returns 'True' if it did exist and has been
6158-- deleted and 'False' if it did not exist.
6259deleteBlocksSlotNo ::
6360 MonadIO m =>
6461 Trace IO Text ->
6562 TxOutTableType ->
6663 SlotNo ->
67- Maybe Bool ->
64+ Bool ->
6865 ReaderT SqlBackend m Bool
69- deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) mIsConsumedTxOut = do
66+ deleteBlocksSlotNo trce txOutTableType (SlotNo slotNo) isConsumedTxOut = do
7067 mBlockId <- queryNearestBlockSlotNo slotNo
7168 case mBlockId of
7269 Nothing -> do
7370 liftIO $ logWarning trce $ " deleteBlocksSlotNo: No block contains the the slot: " <> pack (show slotNo)
7471 pure False
7572 Just (blockId, epochN) -> do
76- void $ deleteBlocksBlockId trce txOutTableType blockId epochN mIsConsumedTxOut
73+ void $ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut
7774 pure True
7875
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-
8376-- | Delete starting from a 'BlockId'.
8477deleteBlocksBlockId ::
8578 MonadIO m =>
@@ -89,20 +82,19 @@ deleteBlocksBlockId ::
8982 -- | The 'EpochNo' of the block to delete.
9083 Word64 ->
9184 -- | Is ConsumeTxout
92- Maybe Bool ->
85+ Bool ->
9386 ReaderT SqlBackend m Int64
94- deleteBlocksBlockId trce txOutTableType blockId epochN mIsConsumedTxOut = do
87+ deleteBlocksBlockId trce txOutTableType blockId epochN isConsumedTxOut = do
9588 mMinIds <- fmap (textToMinIds txOutTableType =<< ) <$> queryReverseIndexBlockId blockId
9689 (cminIds, completed) <- findMinIdsRec mMinIds mempty
9790 mTxId <- queryMinRefId TxBlockId blockId
9891 minIds <- if completed then pure cminIds else completeMinId mTxId cminIds
9992 deleteEpochLogs <- deleteUsingEpochNo epochN
10093 (deleteBlockCount, blockDeleteLogs) <- deleteTablesAfterBlockId txOutTableType blockId mTxId minIds
10194 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 )
10698 -- log all the deleted rows in the rollback
10799 liftIO $ logInfo trce $ mkRollbackSummary (deleteEpochLogs <> blockDeleteLogs) setNullLogs
108100 pure deleteBlockCount
@@ -357,17 +349,6 @@ deleteDelistedPool poolHash = do
357349 mapM_ delete keys
358350 pure $ not (null keys)
359351
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-
371352mkRollbackSummary :: [(Text , Int64 )] -> (Text , Int64 ) -> Text
372353mkRollbackSummary logs setNullLogs =
373354 " \n ----------------------- Rollback Summary: ----------------------- \n "
@@ -392,3 +373,25 @@ mkRollbackSummary logs setNullLogs =
392373 <> if nullCount == 0
393374 then nullMessage
394375 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 False
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