Skip to content

Commit bcc5b88

Browse files
committed
Define SnapshotManager
Different LedgerDB backends will manage snapshots in different ways. In particular, before LSM trees each snapshot was fully contained in a directory in the ledger folder of the ChainDB. However LSM trees store part of the snapshot in the LSM database, which might be somewhere else. The SnapshotManagement record of functions provide a common interface for managing the snapshots.
1 parent e64f515 commit bcc5b88

File tree

11 files changed

+311
-194
lines changed

11 files changed

+311
-194
lines changed

ouroboros-consensus-cardano/app/snapshot-converter.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -242,7 +242,7 @@ store config@Config{outpath = pathToDiskSnapshot -> Just (fs@(SomeHasFS hasFS),
242242
Mem -> do
243243
lseq <- V2.empty state tbs $ V2.newInMemoryLedgerTablesHandle nullTracer fs
244244
let h = V2.currentHandle lseq
245-
Monad.void $ V2.takeSnapshot ccfg nullTracer fs suffix h
245+
Monad.void $ V2.implTakeSnapshot ccfg nullTracer fs suffix h
246246
LMDB -> do
247247
chlog <- newTVarIO (V1.empty state)
248248
lock <- V1.mkLedgerDBLock
@@ -254,7 +254,7 @@ store config@Config{outpath = pathToDiskSnapshot -> Just (fs@(SomeHasFS hasFS),
254254
(V1.SnapshotsFS fs)
255255
(V1.InitFromValues (pointSlot $ getTip state) state tbs)
256256
Monad.void $ V1.withReadLock lock $ do
257-
V1.takeSnapshot chlog ccfg nullTracer (V1.SnapshotsFS fs) bs suffix
257+
V1.implTakeSnapshot chlog ccfg nullTracer (V1.SnapshotsFS fs) bs suffix
258258
store _ _ _ _ = error "Malformed output path!"
259259

260260
main :: IO ()

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Control.ResourceRegistry
1717
import Control.Tracer (Tracer (..), nullTracer)
1818
import qualified Data.SOP.Dict as Dict
1919
import Data.Singletons (Sing, SingI (..))
20+
import Data.Void
2021
import qualified Debug.Trace as Debug
2122
import Ouroboros.Consensus.Block
2223
import Ouroboros.Consensus.Config
@@ -38,8 +39,10 @@ import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
3839
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1 as LedgerDB.V1
3940
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as LedgerDB.V1
4041
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
42+
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Snapshots as LedgerDB.V1
4143
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2 as LedgerDB.V2
4244
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as LedgerDB.V2
45+
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
4346
import Ouroboros.Consensus.Util.Args
4447
import Ouroboros.Consensus.Util.IOLike
4548
import Ouroboros.Consensus.Util.Orphans ()
@@ -64,26 +67,34 @@ openLedgerDB ::
6467
, LedgerDB.TestInternals' IO blk
6568
)
6669
openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV1 bss} = do
70+
let snapManager = LedgerDB.V1.snapshotManager lgrDbArgs
6771
(ledgerDB, _, intLedgerDB) <-
6872
LedgerDB.openDBInternal
6973
lgrDbArgs
7074
( LedgerDB.V1.mkInitDb
7175
lgrDbArgs
7276
bss
7377
(\_ -> error "no replay")
78+
snapManager
7479
)
80+
snapManager
7581
emptyStream
7682
genesisPoint
7783
pure (ledgerDB, intLedgerDB)
7884
openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV2 args} = do
85+
(snapManager, bss') <- case args of
86+
LedgerDB.V2.V2Args LedgerDB.V2.InMemoryHandleArgs -> pure (InMemory.snapshotManager lgrDbArgs, LedgerDB.V2.InMemoryHandleEnv)
87+
LedgerDB.V2.V2Args (LedgerDB.V2.LSMHandleArgs (LedgerDB.V2.LSMArgs x)) -> absurd x
7988
(ledgerDB, _, intLedgerDB) <-
8089
LedgerDB.openDBInternal
8190
lgrDbArgs
8291
( LedgerDB.V2.mkInitDb
8392
lgrDbArgs
84-
args
93+
bss'
8594
(\_ -> error "no replay")
95+
snapManager
8696
)
97+
snapManager
8798
emptyStream
8899
genesisPoint
89100
pure (ledgerDB, intLedgerDB)
Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
For top level release notes, leave all the headers commented out.
6+
-->
7+
8+
<!--
9+
### Patch
10+
11+
- A bullet item for the Patch category.
12+
13+
-->
14+
<!--
15+
### Non-Breaking
16+
17+
- A bullet item for the Non-Breaking category.
18+
19+
-->
20+
### Breaking
21+
22+
- Group snapshot management functions in the new datatype `SnapshotManager`.

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

Lines changed: 24 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Ouroboros.Consensus.Storage.LedgerDB
1818
) where
1919

2020
import Data.Functor.Contravariant ((>$<))
21+
import Data.Void
2122
import Data.Word
2223
import Ouroboros.Consensus.Block
2324
import Ouroboros.Consensus.HardFork.Abstract
@@ -27,9 +28,13 @@ import Ouroboros.Consensus.Storage.ImmutableDB.Stream
2728
import Ouroboros.Consensus.Storage.LedgerDB.API
2829
import Ouroboros.Consensus.Storage.LedgerDB.Args
2930
import Ouroboros.Consensus.Storage.LedgerDB.Forker
31+
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
3032
import Ouroboros.Consensus.Storage.LedgerDB.TraceEvent
3133
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1 as V1
34+
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Snapshots as V1
3235
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2 as V2
36+
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as V2
37+
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
3338
import Ouroboros.Consensus.Util.Args
3439
import Ouroboros.Consensus.Util.CallStack
3540
import Ouroboros.Consensus.Util.IOLike
@@ -39,11 +44,11 @@ openDB ::
3944
forall m blk.
4045
( IOLike m
4146
, LedgerSupportsProtocol blk
42-
, LedgerDbSerialiseConstraints blk
4347
, InspectLedger blk
4448
, HasCallStack
4549
, HasHardForkHistory blk
4650
, LedgerSupportsLedgerDB blk
51+
, LedgerDbSerialiseConstraints blk
4752
) =>
4853
-- | Stateless initializaton arguments
4954
Complete LedgerDbArgs m blk ->
@@ -65,38 +70,45 @@ openDB
6570
replayGoal
6671
getBlock = case lgrFlavorArgs args of
6772
LedgerDbFlavorArgsV1 bss ->
68-
let initDb =
73+
let snapManager = V1.snapshotManager args
74+
initDb =
6975
V1.mkInitDb
7076
args
7177
bss
7278
getBlock
73-
in doOpenDB args initDb stream replayGoal
74-
LedgerDbFlavorArgsV2 bss ->
79+
snapManager
80+
in doOpenDB args initDb snapManager stream replayGoal
81+
LedgerDbFlavorArgsV2 bss -> do
82+
(snapManager, bss') <- case bss of
83+
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManager args, V2.InMemoryHandleEnv)
84+
V2.V2Args (V2.LSMHandleArgs (V2.LSMArgs x)) -> absurd x
7585
let initDb =
7686
V2.mkInitDb
7787
args
78-
bss
88+
bss'
7989
getBlock
80-
in doOpenDB args initDb stream replayGoal
90+
snapManager
91+
doOpenDB args initDb snapManager stream replayGoal
8192

8293
{-------------------------------------------------------------------------------
8394
Opening a LedgerDB
8495
-------------------------------------------------------------------------------}
8596

8697
doOpenDB ::
87-
forall m blk db.
98+
forall m n blk db st.
8899
( IOLike m
89100
, LedgerSupportsProtocol blk
90101
, InspectLedger blk
91102
, HasCallStack
92103
) =>
93104
Complete LedgerDbArgs m blk ->
94105
InitDB db m blk ->
106+
SnapshotManager m n blk st ->
95107
StreamAPI m blk blk ->
96108
Point blk ->
97109
m (LedgerDB' m blk, Word64)
98-
doOpenDB args initDb stream replayGoal =
99-
f <$> openDBInternal args initDb stream replayGoal
110+
doOpenDB args initDb snapManager stream replayGoal =
111+
f <$> openDBInternal args initDb snapManager stream replayGoal
100112
where
101113
f (ldb, replayCounter, _) = (ldb, replayCounter)
102114

@@ -109,28 +121,28 @@ openDBInternal ::
109121
) =>
110122
Complete LedgerDbArgs m blk ->
111123
InitDB db m blk ->
124+
SnapshotManager m n blk st ->
112125
StreamAPI m blk blk ->
113126
Point blk ->
114127
m (LedgerDB' m blk, Word64, TestInternals' m blk)
115-
openDBInternal args@(LedgerDbArgs{lgrHasFS = SomeHasFS fs}) initDb stream replayGoal = do
128+
openDBInternal args@(LedgerDbArgs{lgrHasFS = SomeHasFS fs}) initDb snapManager stream replayGoal = do
116129
createDirectoryIfMissing fs True (mkFsPath [])
117130
(_initLog, db, replayCounter) <-
118131
initialize
119132
replayTracer
120133
snapTracer
121-
lgrHasFS
122134
lgrConfig
123135
stream
124136
replayGoal
125137
initDb
138+
snapManager
126139
lgrStartSnapshot
127140
(ledgerDb, internal) <- mkLedgerDb initDb db
128141
return (ledgerDb, replayCounter, internal)
129142
where
130143
LedgerDbArgs
131144
{ lgrConfig
132145
, lgrTracer
133-
, lgrHasFS
134146
, lgrStartSnapshot
135147
} = args
136148

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

Lines changed: 11 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,6 @@ import Ouroboros.Consensus.Util.IOLike
193193
import Ouroboros.Consensus.Util.IndexedMemPack
194194
import Ouroboros.Network.Block
195195
import Ouroboros.Network.Protocol.LocalStateQuery.Type
196-
import System.FS.API
197196

198197
{-------------------------------------------------------------------------------
199198
Main API
@@ -452,7 +451,7 @@ data InitDB db m blk = InitDB
452451
-- ^ Create a DB from the genesis state
453452
, initFromSnapshot :: !(DiskSnapshot -> m (Either (SnapshotFailure blk) (db, RealPoint blk)))
454453
-- ^ Create a DB from a Snapshot
455-
, closeDb :: !(db -> m ())
454+
, abortLedgerDbInit :: !(db -> m ())
456455
-- ^ Closing the database, to be reopened again with a different snapshot or
457456
-- with the genesis state.
458457
, initReapplyBlock :: !(LedgerDbCfg (ExtLedgerState blk) -> blk -> db -> m db)
@@ -488,35 +487,35 @@ data InitDB db m blk = InitDB
488487
-- obtained in this way will (hopefully) share much of their memory footprint
489488
-- with their predecessors.
490489
initialize ::
491-
forall m blk db.
490+
forall m n blk db st.
492491
( IOLike m
493492
, LedgerSupportsProtocol blk
494493
, InspectLedger blk
495494
, HasCallStack
496495
) =>
497496
Tracer m (TraceReplayEvent blk) ->
498497
Tracer m (TraceSnapshotEvent blk) ->
499-
SomeHasFS m ->
500498
LedgerDbCfg (ExtLedgerState blk) ->
501499
StreamAPI m blk blk ->
502500
Point blk ->
503501
InitDB db m blk ->
502+
SnapshotManager m n blk st ->
504503
Maybe DiskSnapshot ->
505504
m (InitLog blk, db, Word64)
506505
initialize
507506
replayTracer
508507
snapTracer
509-
hasFS
510508
cfg
511509
stream
512510
replayGoal
513511
dbIface
512+
snapManager
514513
fromSnapshot =
515514
case fromSnapshot of
516-
Nothing -> listSnapshots hasFS >>= tryNewestFirst id
515+
Nothing -> listSnapshots snapManager >>= tryNewestFirst id
517516
Just snap -> tryNewestFirst id [snap]
518517
where
519-
InitDB{initFromGenesis, initFromSnapshot, closeDb} = dbIface
518+
InitDB{initFromGenesis, initFromSnapshot, abortLedgerDbInit} = dbIface
520519

521520
tryNewestFirst ::
522521
(InitLog blk -> InitLog blk) ->
@@ -543,7 +542,7 @@ initialize
543542

544543
case eDB of
545544
Left err -> do
546-
closeDb initDb
545+
abortLedgerDbInit initDb
547546
error $ "Invariant violation: invalid immutable chain " <> show err
548547
Right (db, replayed) -> do
549548
db' <- pruneDb dbIface db
@@ -573,15 +572,15 @@ initialize
573572
traceWith snapTracer $ InvalidSnapshot s err
574573
Monad.when (diskSnapshotIsTemporary s) $ do
575574
traceWith snapTracer $ DeletedSnapshot s
576-
deleteSnapshot hasFS s
575+
deleteSnapshot snapManager s
577576
tryNewestFirst (acc . InitFailure s err) ss
578577

579578
-- If we fail to use this snapshot for any other reason, delete it and
580579
-- try an older one
581580
Left err -> do
582581
Monad.when (diskSnapshotIsTemporary s || err == InitFailureGenesis) $ do
583582
traceWith snapTracer $ DeletedSnapshot s
584-
deleteSnapshot hasFS s
583+
deleteSnapshot snapManager s
585584
traceWith snapTracer . InvalidSnapshot s $ err
586585
tryNewestFirst (acc . InitFailure s err) ss
587586
Right (initDb, pt) -> do
@@ -600,8 +599,8 @@ initialize
600599
case eDB of
601600
Left err -> do
602601
traceWith snapTracer . InvalidSnapshot s $ err
603-
Monad.when (diskSnapshotIsTemporary s) $ deleteSnapshot hasFS s
604-
closeDb initDb
602+
Monad.when (diskSnapshotIsTemporary s) $ deleteSnapshot snapManager s
603+
abortLedgerDbInit initDb
605604
tryNewestFirst (acc . InitFailure s err) ss
606605
Right (db, replayed) -> do
607606
db' <- pruneDb dbIface db

0 commit comments

Comments
 (0)