Skip to content

Commit d74420f

Browse files
jasagredojasagredo
committed
TOSQUASH: code review
1 parent 3d3e520 commit d74420f

File tree

8 files changed

+39
-40
lines changed

8 files changed

+39
-40
lines changed

‎cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ repository cardano-haskell-packages
1414
-- update either of these.
1515
index-state:
1616
-- Bump this if you need newer packages from Hackage
17-
, hackage.haskell.org 2025-07-17T14:32:30Z
17+
, hackage.haskell.org 2025-07-22T09:13:54Z
1818
-- Bump this if you need newer packages from CHaP
1919
, cardano-haskell-packages 2025-07-02T14:54:39Z
2020

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ openLedgerDB ::
7070
, LedgerDB.TestInternals' IO blk
7171
)
7272
openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV1 bss} = do
73-
let snapManager = V1.snapshotManagement lgrDbArgs
73+
let snapManager = V1.snapshotManager lgrDbArgs
7474
(ledgerDB, _, intLedgerDB) <-
7575
LedgerDB.openDBInternal
7676
lgrDbArgs
@@ -86,9 +86,9 @@ openLedgerDB [email protected]{LedgerDB.lgrFlavorArgs = LedgerDB.L
8686
pure (ledgerDB, intLedgerDB)
8787
openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV2 args} = do
8888
(snapManager, bss') <- case args of
89-
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManagement lgrDbArgs, V2.InMemoryHandleEnv)
89+
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManager lgrDbArgs, V2.InMemoryHandleEnv)
9090
V2.V2Args (V2.LSMHandleArgs (V2.LSMArgs path genSalt mkFS)) -> do
91-
(rk1, V2.SomeHasFSAndBlockIO fs' blockio) <- mkFS (LedgerDB.lgrRegistry lgrDbArgs) "lsm"
91+
(rk1, V2.SomeHasFSAndBlockIO fs' blockio) <- mkFS (LedgerDB.lgrRegistry lgrDbArgs)
9292
session <-
9393
allocate
9494
(LedgerDB.lgrRegistry lgrDbArgs)
@@ -104,7 +104,7 @@ openLedgerDB [email protected]{LedgerDB.lgrFlavorArgs = LedgerDB.L
104104
(mkFsPath [path])
105105
)
106106
LSM.closeSession
107-
pure (LSM.snapshotManagement (snd session) lgrDbArgs, V2.LSMHandleEnv session rk1)
107+
pure (LSM.snapshotManager (snd session) lgrDbArgs, V2.LSMHandleEnv session rk1)
108108
(ledgerDB, _, intLedgerDB) <-
109109
LedgerDB.openDBInternal
110110
lgrDbArgs

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ openDB
7070
replayGoal
7171
getBlock = case lgrFlavorArgs args of
7272
LedgerDbFlavorArgsV1 bss ->
73-
let snapManager = V1.snapshotManagement args
73+
let snapManager = V1.snapshotManager args
7474
initDb =
7575
V1.mkInitDb
7676
args
@@ -80,9 +80,9 @@ openDB
8080
in doOpenDB args initDb snapManager stream replayGoal
8181
LedgerDbFlavorArgsV2 bss -> do
8282
(snapManager, bss') <- case bss of
83-
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManagement args, V2.InMemoryHandleEnv)
83+
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManager args, V2.InMemoryHandleEnv)
8484
V2.V2Args (V2.LSMHandleArgs (V2.LSMArgs path genSalt mkFS)) -> do
85-
(rk1, V2.SomeHasFSAndBlockIO fs blockio) <- mkFS (lgrRegistry args) "lsm"
85+
(rk1, V2.SomeHasFSAndBlockIO fs blockio) <- mkFS (lgrRegistry args)
8686
session <-
8787
allocate
8888
(lgrRegistry args)
@@ -96,7 +96,7 @@ openDB
9696
(mkFsPath [path])
9797
)
9898
LSM.closeSession
99-
pure (LSM.snapshotManagement (snd session) args, V2.LSMHandleEnv session rk1)
99+
pure (LSM.snapshotManager (snd session) args, V2.LSMHandleEnv session rk1)
100100
let initDb =
101101
V2.mkInitDb
102102
args

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -129,7 +129,7 @@
129129
--
130130
-- ------------------------------------------------------------------------------
131131
module Ouroboros.Consensus.Storage.LedgerDB.V1.Snapshots
132-
( snapshotManagement
132+
( snapshotManager
133133
, loadSnapshot
134134

135135
-- * snapshot-converter
@@ -164,20 +164,20 @@ import Ouroboros.Consensus.Util.Enclose
164164
import Ouroboros.Consensus.Util.IOLike
165165
import System.FS.API
166166

167-
snapshotManagement ::
167+
snapshotManager ::
168168
( IOLike m
169169
, LedgerDbSerialiseConstraints blk
170170
, LedgerSupportsProtocol blk
171171
) =>
172172
Complete LedgerDbArgs m blk ->
173173
SnapshotManager m (ReadLocked m) blk (StrictTVar m (DbChangelog' blk), BackingStore' m blk)
174-
snapshotManagement args =
175-
snapshotManagement'
174+
snapshotManager args =
175+
snapshotManager'
176176
(configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
177177
(LedgerDBSnapshotEvent >$< lgrTracer args)
178178
(SnapshotsFS (lgrHasFS args))
179179

180-
snapshotManagement' ::
180+
snapshotManager' ::
181181
( IOLike m
182182
, LedgerDbSerialiseConstraints blk
183183
, LedgerSupportsProtocol blk
@@ -186,7 +186,7 @@ snapshotManagement' ::
186186
Tracer m (TraceSnapshotEvent blk) ->
187187
SnapshotsFS m ->
188188
SnapshotManager m (ReadLocked m) blk (StrictTVar m (DbChangelog' blk), BackingStore' m blk)
189-
snapshotManagement' ccfg tracer sfs@(SnapshotsFS fs) =
189+
snapshotManager' ccfg tracer sfs@(SnapshotsFS fs) =
190190
SnapshotManager
191191
{ listSnapshots = defaultListSnapshots fs
192192
, deleteSnapshot = defaultDeleteSnapshot fs tracer

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Args.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,10 @@ data HandleArgs f m
2727

2828
data LSMHandleArgs f m = LSMArgs
2929
{ lsmFilePath :: HKD f FilePath
30+
-- ^ The file path relative to the fast storage directory in which the LSM
31+
-- trees database will be located.
3032
, lsmGenSalt :: HKD f (m Salt)
31-
, lsmMkFS :: HKD f (ResourceRegistry m -> FilePath -> m (ResourceKey m, SomeHasFSAndBlockIO m))
33+
, lsmMkFS :: HKD f (ResourceRegistry m -> m (ResourceKey m, SomeHasFSAndBlockIO m))
3234
}
3335

3436
data SomeHasFSAndBlockIO m where

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
2323

2424
-- * Snapshots
2525
, loadSnapshot
26-
, snapshotManagement
26+
, snapshotManager
2727

2828
-- * snapshot-converter
2929
, implTakeSnapshot
@@ -156,20 +156,20 @@ newInMemoryLedgerTablesHandle tracer someFS@(SomeHasFS hasFS) l = do
156156
Snapshots
157157
-------------------------------------------------------------------------------}
158158

159-
snapshotManagement ::
159+
snapshotManager ::
160160
( IOLike m
161161
, LedgerDbSerialiseConstraints blk
162162
, LedgerSupportsProtocol blk
163163
) =>
164164
Complete LedgerDbArgs m blk ->
165165
SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
166-
snapshotManagement args =
167-
snapshotManagement'
166+
snapshotManager args =
167+
snapshotManager'
168168
(configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
169169
(LedgerDBSnapshotEvent >$< lgrTracer args)
170170
(lgrHasFS args)
171171

172-
snapshotManagement' ::
172+
snapshotManager' ::
173173
( IOLike m
174174
, LedgerDbSerialiseConstraints blk
175175
, LedgerSupportsProtocol blk
@@ -178,7 +178,7 @@ snapshotManagement' ::
178178
Tracer m (TraceSnapshotEvent blk) ->
179179
SomeHasFS m ->
180180
SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
181-
snapshotManagement' ccfg tracer fs =
181+
snapshotManager' ccfg tracer fs =
182182
SnapshotManager
183183
{ listSnapshots = defaultListSnapshots fs
184184
, deleteSnapshot = defaultDeleteSnapshot fs tracer

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs

Lines changed: 12 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
2929
-- * Snapshots
3030
, loadSnapshot
3131
, snapshotToStatePath
32-
, snapshotManagement
32+
, snapshotManager
3333

3434
-- * Serialise helpers
3535
, serialiseLSMViaMemPack
@@ -96,7 +96,6 @@ import Ouroboros.Consensus.Util.IOLike
9696
import System.FS.API
9797
import qualified System.FS.BlockIO.API as BIO
9898
import System.FS.BlockIO.IO
99-
import qualified System.FilePath as FilePath
10099
import System.Random
101100
import Prelude hiding (read)
102101

@@ -141,22 +140,22 @@ guardClosed tv f =
141140
LedgerTablesHandleClosed -> error $ show LSMClosedExn
142141
LedgerTablesHandleOpen st -> f st
143142

144-
snapshotManagement ::
143+
snapshotManager ::
145144
( IOLike m
146145
, LedgerDbSerialiseConstraints blk
147146
, LedgerSupportsProtocol blk
148147
) =>
149148
Session m ->
150149
Complete LedgerDbArgs m blk ->
151150
SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
152-
snapshotManagement session args =
153-
snapshotManagement'
151+
snapshotManager session args =
152+
snapshotManager'
154153
session
155154
(configCodec . getExtLedgerCfg . ledgerDbCfg $ lgrConfig args)
156155
(LedgerDBSnapshotEvent >$< lgrTracer args)
157156
(lgrHasFS args)
158157

159-
snapshotManagement' ::
158+
snapshotManager' ::
160159
( IOLike m
161160
, LedgerDbSerialiseConstraints blk
162161
, LedgerSupportsProtocol blk
@@ -166,7 +165,7 @@ snapshotManagement' ::
166165
Tracer m (TraceSnapshotEvent blk) ->
167166
SomeHasFS m ->
168167
SnapshotManager m m blk (StateRef m (ExtLedgerState blk))
169-
snapshotManagement' session ccfg tracer fs =
168+
snapshotManager' session ccfg tracer fs =
170169
SnapshotManager
171170
{ listSnapshots = defaultListSnapshots fs
172171
, deleteSnapshot = implDeleteSnapshot session fs tracer
@@ -327,9 +326,7 @@ writeSnapshot ::
327326
writeSnapshot fs@(SomeHasFS hasFs) encLedger ds st = do
328327
createDirectoryIfMissing hasFs True $ snapshotToDirPath ds
329328
crc1 <- writeExtLedgerState fs encLedger (snapshotToStatePath ds) $ state st
330-
crc2 <-
331-
takeHandleSnapshot (tables st) (state st) $
332-
show (dsNumber ds) <> maybe "" (("_" <>) . show) (dsSuffix ds)
329+
crc2 <- takeHandleSnapshot (tables st) (state st) $ snapshotToDirName ds
333330
writeSnapshotMetadata fs ds $
334331
SnapshotMetadata
335332
{ snapshotBackend = UTxOHDLSMSnapshot
@@ -345,7 +342,7 @@ implDeleteSnapshot session (SomeHasFS HasFS{doesDirectoryExist, removeDirectoryR
345342
Monad.when exists (removeDirectoryRecursive p)
346343
LSM.deleteSnapshot
347344
session
348-
(fromString $ show (dsNumber ss) <> maybe "" (("_" <>) . show) (dsSuffix ss))
345+
(fromString $ show (dsNumber ss) <> maybe "" ("_" <>) (dsSuffix ss))
349346
traceWith tracer (DeletedSnapshot ss)
350347

351348
-- | Read snapshot from disk.
@@ -388,7 +385,7 @@ loadSnapshot tracer rr ccfg fs session ds = do
388385
( \_ ->
389386
LSM.openTableFromSnapshot
390387
session
391-
(fromString $ show (dsNumber ds) <> maybe "" (("_" <>) . show) (dsSuffix ds))
388+
(fromString $ snapshotToDirName ds)
392389
"UTxO table"
393390
)
394391
LSM.closeTable
@@ -413,11 +410,11 @@ stdGenSalt :: IO LSM.Salt
413410
stdGenSalt = fst . genWord64 <$> initStdGen
414411

415412
stdMkBlockIOFS ::
416-
FilePath -> ResourceRegistry IO -> FilePath -> IO (ResourceKey IO, V2.SomeHasFSAndBlockIO IO)
417-
stdMkBlockIOFS fastStoragePath rr relPath = do
413+
FilePath -> ResourceRegistry IO -> IO (ResourceKey IO, V2.SomeHasFSAndBlockIO IO)
414+
stdMkBlockIOFS fastStoragePath rr = do
418415
(rk1, bio) <-
419416
allocate
420417
rr
421-
(\_ -> ioHasBlockIO (MountPoint $ fastStoragePath FilePath.</> relPath) defaultIOCtxParams)
418+
(\_ -> ioHasBlockIO (MountPoint fastStoragePath) defaultIOCtxParams)
422419
(BIO.close . snd)
423420
pure (rk1, uncurry V2.SomeHasFSAndBlockIO bio)

‎ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/StateMachine.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -508,7 +508,7 @@ openLedgerDB flavArgs env cfg fs = do
508508
Nothing
509509
(ldb, _, od) <- case flavArgs of
510510
LedgerDbFlavorArgsV1 bss ->
511-
let snapManager = V1.snapshotManagement args
511+
let snapManager = V1.snapshotManager args
512512
initDb =
513513
V1.mkInitDb
514514
args
@@ -518,7 +518,7 @@ openLedgerDB flavArgs env cfg fs = do
518518
in openDBInternal args initDb snapManager stream replayGoal
519519
LedgerDbFlavorArgsV2 bss -> do
520520
(snapManager, bss') <- case bss of
521-
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManagement args, V2.InMemoryHandleEnv)
521+
V2.V2Args V2.InMemoryHandleArgs -> pure (InMemory.snapshotManager args, V2.InMemoryHandleEnv)
522522
V2.V2Args (V2.LSMHandleArgs (V2.LSMArgs path genSalt mkFS)) -> do
523523
(rk1, V2.SomeHasFSAndBlockIO fs' blockio) <- mkFS (lgrRegistry args) "lsm"
524524
session <-
@@ -534,7 +534,7 @@ openLedgerDB flavArgs env cfg fs = do
534534
(mkFsPath [path])
535535
)
536536
LSM.closeSession
537-
pure (LSM.snapshotManagement (snd session) args, V2.LSMHandleEnv session rk1)
537+
pure (LSM.snapshotManager (snd session) args, V2.LSMHandleEnv session rk1)
538538
let initDb =
539539
V2.mkInitDb
540540
args

0 commit comments

Comments
 (0)