Rename and relocate LedgerDbPrune

Author: jasagredo

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs

@@ -69,7 +69,6 @@ import           Ouroboros.Consensus.Storage.ChainDB.API (ChainDbFailure (..))
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache
                      (BlockCache)
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.BlockCache as BlockCache
-import           Ouroboros.Consensus.Storage.Common (LedgerDBPruneTip (..))
 import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
 import           Ouroboros.Consensus.Storage.ImmutableDB.Stream
 import           Ouroboros.Consensus.Storage.LedgerDB (LedgerDB')
@@ -191,7 +190,7 @@ openDB args@LgrDbArgs { lgrHasFS = lgrHasFS@(SomeHasFS hasFS), .. } replayTracer
     -- >k blocks long. Thus 'Lbn' is the oldest point we can roll back to.
     -- Therefore, we need to make the newest state (current) of the ledger DB
     -- the anchor.
-    let dbPrunedToImmDBTip = LedgerDB.ledgerDbPrune LedgerDBPruneTipZero db
+    let dbPrunedToImmDBTip = LedgerDB.ledgerDbPrune LedgerDB.LedgerDbPruneAll db
     (varDB, varPrevApplied) <-
       (,) <$> newTVarIO dbPrunedToImmDBTip <*> newTVarIO Set.empty
     return (

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/Common.hs

@@ -13,8 +13,6 @@ module Ouroboros.Consensus.Storage.Common (
   , PrefixLen (..)
   , addPrefixLen
   , takePrefix
-    -- * Pruning
-  , LedgerDBPruneTip (..)
     -- * BinaryBlockInfo
   , BinaryBlockInfo (..)
   , extractHeader
@@ -36,7 +34,6 @@ import           Data.Word
 import           GHC.Generics (Generic)
 import           NoThunks.Class (NoThunks)
 import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.Protocol.Abstract (SecurityParam)
 import           Ouroboros.Network.SizeInBytes (SizeInBytes)
 
 {-------------------------------------------------------------------------------
@@ -68,21 +65,6 @@ takePrefix :: PrefixLen -> BL.ByteString -> ShortByteString
 takePrefix (PrefixLen n) =
     Short.toShort . BL.toStrict . BL.take (fromIntegral n)
 
-{-------------------------------------------------------------------------------
-  Pruning
--------------------------------------------------------------------------------}
-
--- | The "tip" to prune snapshots from.
---
--- `SecurityParam` has been updated to use `NonZero` but we need to prune from
--- @0@ in some cases.
---
--- Rather than using a plain `Word64` we use this to be able to distinguish that
--- we are indeed using
---   1. @0@ in places where it is necessary
---   2. the security parameter as is, in other places
-data LedgerDBPruneTip = LedgerDBPruneTipZero | LedgerDBPruneTip SecurityParam
-
 {-------------------------------------------------------------------------------
   BinaryBlockInfo
 -------------------------------------------------------------------------------}

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs

@@ -84,6 +84,7 @@ module Ouroboros.Consensus.Storage.LedgerDB (
   , LedgerDB'
   , LedgerDbCfg
   , LedgerDbCfgF (..)
+  , LedgerDbPrune (..)
   , configLedgerDb
     -- * Initialization
   , InitLog (..)
@@ -174,7 +175,7 @@ import           Ouroboros.Consensus.Storage.LedgerDB.Init (InitLog (..),
                      decorateReplayTracerWithStart, initLedgerDB)
 import           Ouroboros.Consensus.Storage.LedgerDB.LedgerDB (Checkpoint (..),
                      LedgerDB (..), LedgerDB', LedgerDbCfg, LedgerDbCfgF (..),
-                     configLedgerDb)
+                     LedgerDbPrune (..), configLedgerDb)
 import           Ouroboros.Consensus.Storage.LedgerDB.Query (ledgerDbAnchor,
                      ledgerDbCurrent, ledgerDbIsSaturated, ledgerDbMaxRollback,
                      ledgerDbPast, ledgerDbSnapshots, ledgerDbTip)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/LedgerDB.hs

@@ -14,6 +14,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.LedgerDB (
   , LedgerDB'
   , LedgerDbCfg
   , LedgerDbCfgF (..)
+  , LedgerDbPrune (..)
   , configLedgerDb
   ) where
 
@@ -139,3 +140,15 @@ configLedgerDb cfg opts = LedgerDbCfg {
     , ledgerDbCfg         = ExtLedgerCfg cfg
     , ledgerDbCfgComputeLedgerEvents   = opts
     }
+
+{-------------------------------------------------------------------------------
+  Pruning
+-------------------------------------------------------------------------------}
+
+-- | Options for prunning the LedgerDB
+--
+-- Rather than using a plain `Word64` we use this to be able to distinguish that
+-- we are indeed using
+--   1. @0@ in places where it is necessary
+--   2. the security parameter as is, in other places
+data LedgerDbPrune = LedgerDbPruneAll | LedgerDbPruneKeeping SecurityParam

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Update.hs

@@ -61,7 +61,6 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
-import           Ouroboros.Consensus.Storage.Common (LedgerDBPruneTip (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.LedgerDB
 import           Ouroboros.Consensus.Storage.LedgerDB.Query
 import           Ouroboros.Consensus.Util
@@ -234,12 +233,12 @@ ledgerDbBimap f g =
 
 -- | Prune snapshots until at we have at most @k@ snapshots in the LedgerDB,
 -- excluding the snapshots stored at the anchor.
-ledgerDbPrune :: GetTip l => LedgerDBPruneTip -> LedgerDB l -> LedgerDB l
+ledgerDbPrune :: GetTip l => LedgerDbPrune -> LedgerDB l -> LedgerDB l
 ledgerDbPrune tip db =
   let tip' =
         case tip of
-          LedgerDBPruneTipZero               -> 0
-          LedgerDBPruneTip (SecurityParam k) -> unNonZero k
+          LedgerDbPruneAll                       -> 0
+          LedgerDbPruneKeeping (SecurityParam k) -> unNonZero k
    in db {
         ledgerDbCheckpoints = AS.anchorNewest tip' (ledgerDbCheckpoints db)
       }
@@ -260,7 +259,7 @@ pushLedgerState ::
   -> l -- ^ Updated ledger state
   -> LedgerDB l -> LedgerDB l
 pushLedgerState secParam current' db@LedgerDB{..}  =
-    ledgerDbPrune (LedgerDBPruneTip secParam) $ db {
+    ledgerDbPrune (LedgerDbPruneKeeping secParam) $ db {
         ledgerDbCheckpoints = ledgerDbCheckpoints AS.:> Checkpoint current'
       }
 

ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs

@@ -112,7 +112,6 @@ import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      StreamFrom (..), StreamTo (..), UnknownRange (..),
                      validBounds)
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel (olderThanK)
-import           Ouroboros.Consensus.Storage.Common (LedgerDBPruneTip (..))
 import           Ouroboros.Consensus.Storage.LedgerDB
 import           Ouroboros.Consensus.Util (repeatedly)
 import qualified Ouroboros.Consensus.Util.AnchoredFragment as Fragment
@@ -361,11 +360,11 @@ getLedgerDB cfg m@Model{..} =
 
     tip =
       case maxActualRollback k m of
-        0 -> LedgerDBPruneTipZero
+        0 -> LedgerDbPruneAll
         n ->
           -- Since we know that @`n`@ is not zero, it is impossible for `nonZeroOr`
           -- to return a `Nothing` and the final result to have default value of @`1`@.
-          LedgerDBPruneTip $ SecurityParam $ nonZeroOr n $ knownNonZeroBounded @1
+          LedgerDbPruneKeeping $ SecurityParam $ nonZeroOr n $ knownNonZeroBounded @1
 
 getLoEFragment :: Model blk -> LoE (AnchoredFragment blk)
 getLoEFragment = loeFragment