Skip to content

Commit 24e48cc

Browse files
authored
Calculate and compare CRC when writing and reading ledger snapshots (#1319)
Fixes #892 Integration into `cardano-node`: IntersectMBO/cardano-node#6047. This uses the branch [geo2a/issue-892-checksum-snaphot-file-release-ouroboros-consensus-0.21.0.0-backport](https://github.com/IntersectMBO/ouroboros-consensus/tree/geo2a/issue-892-checksum-snaphot-file-release-ouroboros-consensus-0.21.0.0-backport) which is the backport of this PR onto the most resent release of the `ouroboros-consensus` package. In this PR, we change the reading and writing disk snapshots of ledger state. When a snapshot is taken and written to disk, an additional file with the `.checksum` extension is written alongside it. The checksum file contains a string that represent the CRC32 checksum of the snapshot. The checksum is calculated incrementally, alongside writing the snapshot to disk. When a snapshot is read from dist, the checksum is again calculated and compared to the tracked one. If the checksum is different, `readSnaphot` returns the `ReadSnapshotDataCorruption` error, indicating data corruption. The checksum is calculated incrementally, alongside reading a writing the data. On write, we use the [`hPutAllCRC`](https://input-output-hk.github.io/fs-sim/fs-api/src/System.FS.CRC.html#hPutAllCRC) function from `fs-sim`, and on read we modify the [readIncremental](https://github.com/IntersectMBO/ouroboros-consensus/blob/892-checksum-snaphot-file/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/CBOR.hs#L191) function to compute the checksum as data is read. To enable seamless integration into `cardano-node`, we make the check optional. When initialising the ledger state from a snapshot in `initLedgerDB`, we issue a warning in case the checksum file is missing for a snapshot, but do not fail as in case of invalid snapshots. The `db-analyser` tool ignores the checksum files by default when reading the snapshots. We add `--disk-snapshot-checksum` flag to enabled the check. When writing a snapshot to disk, e.g. as a result of the `--store-ledger` analysis, `db-analyser` will always write calculate the checksum and write it into the snapshot's `.checksum` file. **Tests** There state machine test in `Test.Ouroboros.Storage.LedgerDB.OnDisk` is relevant to this feature, and has caught a number of silly mistakes in the process of its implementation, for example forgetting to delete a checksum file when the snapshot is deleted. The model in the test does not track checksums, and I do not think it can (or should) be augmented to do that. Howerver, the `Snap` and `Restore` events are now parameterised by the checksum flag, and the values for the flag are randomised when generating these events. This leads to testing the following properties: - this feature is backwards-compatible, i.e. the `Restore` events will always lead to restoring from a snapshot, even if `Snap` events do not write checksum files (i.e. their flag is `NoDoDiskSnapshotChecksum` ~= `False`). - If the interpretation of the `DoDiskSnapshotChecksum` flag changes in the code base and becomes strict, i.e. hard fail if the checksum file is missing, this test will discover that. **Effects on Performance**: Running `db-analyser` to read a ledger snapshot and store the snapshot of the state at the next slot shows a difference of 2 seconds on my machine. See a comment below for the logs. To precisely evaluate the effects, we need a micro-benchmark of the reading and writing of snapshots with and without the checksum calculation.
2 parents 236b0ee + 2eef543 commit 24e48cc

File tree

19 files changed

+324
-104
lines changed

19 files changed

+324
-104
lines changed

ouroboros-consensus-cardano/app/DBAnalyser/Parsers.hs

Lines changed: 17 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
1-
{-# LANGUAGE ApplicativeDo #-}
2-
{-# LANGUAGE CPP #-}
3-
{-# LANGUAGE LambdaCase #-}
1+
{-# LANGUAGE ApplicativeDo #-}
2+
{-# LANGUAGE CPP #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE PatternSynonyms #-}
45

56
module DBAnalyser.Parsers (
67
BlockType (..)
@@ -21,6 +22,7 @@ import Options.Applicative
2122
import Ouroboros.Consensus.Block
2223
import Ouroboros.Consensus.Byron.Node (PBftSignatureThreshold (..))
2324
import Ouroboros.Consensus.Shelley.Node (Nonce (..))
25+
import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (pattern DoDiskSnapshotChecksum, pattern NoDoDiskSnapshotChecksum)
2426

2527
{-------------------------------------------------------------------------------
2628
Parsing
@@ -44,6 +46,10 @@ parseDBAnalyserConfig = DBAnalyserConfig
4446
<*> parseValidationPolicy
4547
<*> parseAnalysis
4648
<*> parseLimit
49+
<*> flag DoDiskSnapshotChecksum NoDoDiskSnapshotChecksum (mconcat [
50+
long "no-snapshot-checksum-on-read"
51+
, help "Don't check the '.checksum' file when reading a ledger snapshot"
52+
])
4753

4854
parseSelectDB :: Parser SelectDB
4955
parseSelectDB =
@@ -130,7 +136,14 @@ storeLedgerParser = do
130136
<> "This is much slower than block reapplication (the default)."
131137
)
132138
)
133-
pure $ StoreLedgerStateAt slot ledgerValidation
139+
doChecksum <- flag DoDiskSnapshotChecksum NoDoDiskSnapshotChecksum
140+
(mconcat [ long "no-snapshot-checksum-on-write"
141+
, help (unlines [ "Don't calculate the checksum and"
142+
, "write the '.checksum' file"
143+
, "when taking a ledger snapshot"
144+
])
145+
])
146+
pure $ StoreLedgerStateAt slot ledgerValidation doChecksum
134147

135148
checkNoThunksParser :: Parser AnalysisName
136149
checkNoThunksParser = CheckNoThunksEvery <$> option auto

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

Lines changed: 17 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
7474
import Ouroboros.Consensus.Storage.LedgerDB (DiskSnapshot (..),
7575
writeSnapshot)
7676
import Ouroboros.Consensus.Storage.Serialisation (encodeDisk)
77-
import Ouroboros.Consensus.Util ((..:))
77+
import Ouroboros.Consensus.Util (Flag (..), (..:))
7878
import qualified Ouroboros.Consensus.Util.IOLike as IOLike
7979
import Ouroboros.Network.SizeInBytes
8080
import System.FS.API (SomeHasFS (..))
@@ -102,19 +102,19 @@ runAnalysis analysisName = case go analysisName of
102102
pure result
103103
where
104104
go :: AnalysisName -> SomeAnalysis blk
105-
go ShowSlotBlockNo = mkAnalysis $ showSlotBlockNo
106-
go CountTxOutputs = mkAnalysis $ countTxOutputs
107-
go ShowBlockHeaderSize = mkAnalysis $ showHeaderSize
108-
go ShowBlockTxsSize = mkAnalysis $ showBlockTxsSize
109-
go ShowEBBs = mkAnalysis $ showEBBs
110-
go OnlyValidation = mkAnalysis @StartFromPoint $ \_ -> pure Nothing
111-
go (StoreLedgerStateAt slotNo lgrAppMode) = mkAnalysis $ storeLedgerStateAt slotNo lgrAppMode
112-
go CountBlocks = mkAnalysis $ countBlocks
113-
go (CheckNoThunksEvery nBks) = mkAnalysis $ checkNoThunksEvery nBks
114-
go TraceLedgerProcessing = mkAnalysis $ traceLedgerProcessing
115-
go (ReproMempoolAndForge nBks) = mkAnalysis $ reproMempoolForge nBks
116-
go (BenchmarkLedgerOps mOutfile lgrAppMode) = mkAnalysis $ benchmarkLedgerOps mOutfile lgrAppMode
117-
go (GetBlockApplicationMetrics nrBlocks mOutfile) = mkAnalysis $ getBlockApplicationMetrics nrBlocks mOutfile
105+
go ShowSlotBlockNo = mkAnalysis $ showSlotBlockNo
106+
go CountTxOutputs = mkAnalysis $ countTxOutputs
107+
go ShowBlockHeaderSize = mkAnalysis $ showHeaderSize
108+
go ShowBlockTxsSize = mkAnalysis $ showBlockTxsSize
109+
go ShowEBBs = mkAnalysis $ showEBBs
110+
go OnlyValidation = mkAnalysis @StartFromPoint $ \_ -> pure Nothing
111+
go (StoreLedgerStateAt slotNo lgrAppMode doChecksum) = mkAnalysis $ storeLedgerStateAt slotNo lgrAppMode doChecksum
112+
go CountBlocks = mkAnalysis $ countBlocks
113+
go (CheckNoThunksEvery nBks) = mkAnalysis $ checkNoThunksEvery nBks
114+
go TraceLedgerProcessing = mkAnalysis $ traceLedgerProcessing
115+
go (ReproMempoolAndForge nBks) = mkAnalysis $ reproMempoolForge nBks
116+
go (BenchmarkLedgerOps mOutfile lgrAppMode) = mkAnalysis $ benchmarkLedgerOps mOutfile lgrAppMode
117+
go (GetBlockApplicationMetrics nrBlocks mOutfile) = mkAnalysis $ getBlockApplicationMetrics nrBlocks mOutfile
118118

119119
mkAnalysis ::
120120
forall startFrom. SingI startFrom
@@ -382,8 +382,9 @@ storeLedgerStateAt ::
382382
)
383383
=> SlotNo
384384
-> LedgerApplicationMode
385+
-> Flag "DoDiskSnapshotChecksum"
385386
-> Analysis blk StartFromLedgerState
386-
storeLedgerStateAt slotNo ledgerAppMode env = do
387+
storeLedgerStateAt slotNo ledgerAppMode doChecksum env = do
387388
void $ processAllUntil db registry GetBlock startFrom limit initLedger process
388389
pure Nothing
389390
where
@@ -422,7 +423,7 @@ storeLedgerStateAt slotNo ledgerAppMode env = do
422423
storeLedgerState ledgerState = case pointSlot pt of
423424
NotOrigin slot -> do
424425
let snapshot = DiskSnapshot (unSlotNo slot) (Just "db-analyser")
425-
writeSnapshot ledgerDbFS encLedger snapshot ledgerState
426+
writeSnapshot ledgerDbFS doChecksum encLedger snapshot ledgerState
426427
traceWith tracer $ SnapshotStoredEvent slot
427428
Origin -> pure ()
428429
where

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ analyse ::
5151
=> DBAnalyserConfig
5252
-> Args blk
5353
-> IO (Maybe AnalysisResult)
54-
analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbose} args =
54+
analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbose, diskSnapshotChecksumOnRead} args =
5555
withRegistry $ \registry -> do
5656
lock <- newMVar ()
5757
chainDBTracer <- mkTracer lock verbose
@@ -92,6 +92,7 @@ analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbo
9292
ledgerDbFS
9393
(decodeDiskExtLedgerState $ configCodec cfg)
9494
decode
95+
diskSnapshotChecksumOnRead
9596
(DiskSnapshot slot (Just "db-analyser"))
9697
-- TODO @readSnapshot@ has type @ExceptT ReadIncrementalErr m
9798
-- (ExtLedgerState blk)@ but it also throws exceptions! This makes

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

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,23 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
23

34
module Cardano.Tools.DBAnalyser.Types (module Cardano.Tools.DBAnalyser.Types) where
45

56
import Data.Word
67
import Ouroboros.Consensus.Block
8+
import Ouroboros.Consensus.Util (Flag)
79

810
data SelectDB =
911
SelectImmutableDB (WithOrigin SlotNo)
1012

1113
data DBAnalyserConfig = DBAnalyserConfig {
12-
dbDir :: FilePath
13-
, verbose :: Bool
14-
, selectDB :: SelectDB
15-
, validation :: Maybe ValidateBlocks
16-
, analysis :: AnalysisName
17-
, confLimit :: Limit
14+
dbDir :: FilePath
15+
, verbose :: Bool
16+
, selectDB :: SelectDB
17+
, validation :: Maybe ValidateBlocks
18+
, analysis :: AnalysisName
19+
, confLimit :: Limit
20+
, diskSnapshotChecksumOnRead :: Flag "DoDiskSnapshotChecksum"
1821
}
1922

2023
data AnalysisName =
@@ -24,7 +27,7 @@ data AnalysisName =
2427
| ShowBlockTxsSize
2528
| ShowEBBs
2629
| OnlyValidation
27-
| StoreLedgerStateAt SlotNo LedgerApplicationMode
30+
| StoreLedgerStateAt SlotNo LedgerApplicationMode (Flag "DoDiskSnapshotChecksum")
2831
| CountBlocks
2932
| CheckNoThunksEvery Word64
3033
| TraceLedgerProcessing

ouroboros-consensus-cardano/test/tools-test/Main.hs

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE PatternSynonyms #-}
2+
13
module Main (main) where
24

35
import qualified Cardano.Tools.DBAnalyser.Block.Cardano as Cardano
@@ -8,6 +10,8 @@ import qualified Cardano.Tools.DBSynthesizer.Run as DBSynthesizer
810
import Cardano.Tools.DBSynthesizer.Types
911
import Ouroboros.Consensus.Block
1012
import Ouroboros.Consensus.Cardano.Block
13+
import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
14+
(pattern NoDoDiskSnapshotChecksum)
1115
import qualified Test.Cardano.Tools.Headers
1216
import Test.Tasty
1317
import Test.Tasty.HUnit
@@ -62,12 +66,13 @@ testImmutaliserConfig =
6266
testAnalyserConfig :: DBAnalyserConfig
6367
testAnalyserConfig =
6468
DBAnalyserConfig {
65-
dbDir = chainDB
66-
, verbose = False
67-
, selectDB = SelectImmutableDB Origin
68-
, validation = Just ValidateAllBlocks
69-
, analysis = CountBlocks
70-
, confLimit = Unlimited
69+
dbDir = chainDB
70+
, verbose = False
71+
, selectDB = SelectImmutableDB Origin
72+
, validation = Just ValidateAllBlocks
73+
, analysis = CountBlocks
74+
, confLimit = Unlimited
75+
, diskSnapshotChecksumOnRead = NoDoDiskSnapshotChecksum
7176
}
7277

7378
testBlockArgs :: Cardano.Args (CardanoBlock StandardCrypto)

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66
{-# LANGUAGE LambdaCase #-}
77
{-# LANGUAGE MonadComprehensions #-}
88
{-# LANGUAGE NamedFieldPuns #-}
9+
{-# LANGUAGE PatternSynonyms #-}
910
{-# LANGUAGE Rank2Types #-}
1011
{-# LANGUAGE RecordWildCards #-}
1112
{-# LANGUAGE ScopedTypeVariables #-}
@@ -51,6 +52,8 @@ module Ouroboros.Consensus.Node (
5152
, RunNodeArgs (..)
5253
, Tracers
5354
, Tracers' (..)
55+
, pattern DoDiskSnapshotChecksum
56+
, pattern NoDoDiskSnapshotChecksum
5457
-- * Internal helpers
5558
, mkNodeKernelArgs
5659
, nodeKernelArgsEnforceInvariants
@@ -107,7 +110,8 @@ import Ouroboros.Consensus.Storage.ChainDB (ChainDB, ChainDbArgs,
107110
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
108111
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.Args as ChainDB
109112
import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
110-
(DiskPolicyArgs (..))
113+
(DiskPolicyArgs (..), pattern DoDiskSnapshotChecksum,
114+
pattern NoDoDiskSnapshotChecksum)
111115
import Ouroboros.Consensus.Util.Args
112116
import Ouroboros.Consensus.Util.IOLike
113117
import Ouroboros.Consensus.Util.Orphans ()
Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
### Breaking
2+
3+
- When writing a ledger state snapshot to disk, calculate the state's CRC32 checksum and write it to a separate file, which is named the same as the snapshot file, plus the `.checksum` extension.
4+
- When reading a snapshot file in `readSnapshot`, calculate its checksum and compare it to the value in the corresponding `.checksum` file. Return an error if the checksum is different or invalid. Issue a warning if the checksum file does not exist, but still initialise the ledger DB.
5+
- To support the previous item, change the error type of the `readSnapshot` from `ReadIncrementalErr` to the extended `ReadSnaphotErr`.
6+
- Checksumming the snapshots is controlled via the `doChecksum :: Flag "DoDiskSnapshotChecksum"` parameter of `initFromSnapshot`. Ultimately, this parameter comes from the Node's configuration file via the `DiskPolicy` data type.
7+
- Extend the `DiskPolicyArgs` data type to enable the node to pass `Flag "DoDiskSnapshotChecksum"` to Consensus.
8+
9+
### Non-breaking
10+
11+
- Make `Ouroboros.Consensus.Util.CBOR.readIncremental` optionally compute the checksum of the data as it is read.
12+
- Introduce an explicit `Ord` instance for `DiskSnapshot` that compares the values on `dsNumber`.
13+
- Introduce a new utility newtype `Flag` to represent type-safe boolean flags. See ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util.hs.
14+
- Use `Flag "DoDiskSnapshotChecksum"` to control the check of the snapshot checksum file in `takeSnapshot`, `readSnapshot` and `writeSnapshot`.

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

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -232,9 +232,11 @@ initFromDisk LgrDbArgs { lgrHasFS = hasFS, .. }
232232
lgrConfig
233233
lgrGenesis
234234
(streamAPI immutableDB)
235+
doDiskSnapshotChecksum
235236
return (db, replayed)
236237
where
237238
ccfg = configCodec $ getExtLedgerCfg $ LedgerDB.ledgerDbCfg lgrConfig
239+
LedgerDB.DiskPolicyArgs _ _ doDiskSnapshotChecksum = lgrDiskPolicyArgs
238240

239241
-- | For testing purposes
240242
mkLgrDB :: StrictTVar m (LedgerDB' blk)
@@ -280,11 +282,12 @@ takeSnapshot ::
280282
, IsLedger (LedgerState blk)
281283
)
282284
=> LgrDB m blk -> m (Maybe (LedgerDB.DiskSnapshot, RealPoint blk))
283-
takeSnapshot lgrDB@LgrDB{ cfg, tracer, hasFS } = wrapFailure (Proxy @blk) $ do
285+
takeSnapshot lgrDB@LgrDB{ cfg, tracer, hasFS, diskPolicy } = wrapFailure (Proxy @blk) $ do
284286
ledgerDB <- LedgerDB.ledgerDbAnchor <$> atomically (getCurrent lgrDB)
285287
LedgerDB.takeSnapshot
286288
tracer
287289
hasFS
290+
(LedgerDB.onDiskShouldChecksumSnapshots diskPolicy)
288291
(encodeDiskExtLedgerState ccfg)
289292
ledgerDB
290293
where

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

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE PatternSynonyms #-}
2+
13
-- | The Ledger DB is responsible for the following tasks:
24
--
35
-- - __Maintaining the in-memory ledger state at the tip__: When we try to
@@ -134,6 +136,8 @@ module Ouroboros.Consensus.Storage.LedgerDB (
134136
, SnapshotFailure (..)
135137
, diskSnapshotIsTemporary
136138
, listSnapshots
139+
, pattern DoDiskSnapshotChecksum
140+
, pattern NoDoDiskSnapshotChecksum
137141
, readSnapshot
138142
-- ** Write to disk
139143
, takeSnapshot
@@ -160,7 +164,9 @@ module Ouroboros.Consensus.Storage.LedgerDB (
160164
import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
161165
(DiskPolicy (..), DiskPolicyArgs (..),
162166
NumOfDiskSnapshots (..), SnapshotInterval (..),
163-
TimeSinceLast (..), defaultDiskPolicyArgs, mkDiskPolicy)
167+
TimeSinceLast (..), defaultDiskPolicyArgs, mkDiskPolicy,
168+
pattern DoDiskSnapshotChecksum,
169+
pattern NoDoDiskSnapshotChecksum)
164170
import Ouroboros.Consensus.Storage.LedgerDB.Init (InitLog (..),
165171
ReplayGoal (..), ReplayStart (..), TraceReplayEvent (..),
166172
decorateReplayTracerWithGoal,

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

Lines changed: 26 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
{-# LANGUAGE DeriveGeneric #-}
44
{-# LANGUAGE DerivingVia #-}
55
{-# LANGUAGE NumericUnderscores #-}
6+
{-# LANGUAGE PatternSynonyms #-}
67
{-# LANGUAGE RecordWildCards #-}
78

89
module Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (
@@ -13,6 +14,10 @@ module Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (
1314
, TimeSinceLast (..)
1415
, defaultDiskPolicyArgs
1516
, mkDiskPolicy
17+
, pattern DoDiskSnapshotChecksum
18+
, pattern NoDoDiskSnapshotChecksum
19+
-- * Re-exports
20+
, Flag (..)
1621
) where
1722

1823
import Control.Monad.Class.MonadTime.SI
@@ -21,27 +26,36 @@ import Data.Word
2126
import GHC.Generics
2227
import NoThunks.Class (NoThunks, OnlyCheckWhnf (..))
2328
import Ouroboros.Consensus.Config.SecurityParam
29+
import Ouroboros.Consensus.Util (Flag (..))
2430

2531
-- | Length of time, requested by the user, that has to pass after which
2632
-- a snapshot is taken. It can be:
2733
--
2834
-- 1. either explicitly provided by user in seconds
29-
-- 2. or default value can be requested - the specific DiskPolicy determines
35+
-- 2. or default value can be requested - the specific @'DiskPolicy'@ determines
3036
-- what that is exactly, see `mkDiskPolicy` as an example
3137
data SnapshotInterval =
3238
DefaultSnapshotInterval
3339
| RequestedSnapshotInterval DiffTime
3440
deriving stock (Eq, Generic, Show)
3541

3642
-- | Number of snapshots to be stored on disk. This is either the default value
37-
-- as determined by the DiskPolicy, or it is provided by the user. See the
38-
-- `DiskPolicy` documentation for more information.
43+
-- as determined by the @'DiskPolicy'@, or it is provided by the user. See the
44+
-- @'DiskPolicy'@ documentation for more information.
3945
data NumOfDiskSnapshots =
4046
DefaultNumOfDiskSnapshots
4147
| RequestedNumOfDiskSnapshots Word
4248
deriving stock (Eq, Generic, Show)
4349

44-
data DiskPolicyArgs = DiskPolicyArgs SnapshotInterval NumOfDiskSnapshots
50+
-- | Type-safe flag to regulate the checksum policy of the ledger state snapshots.
51+
--
52+
-- These patterns are exposed to cardano-node and will be passed as part of @'DiskPolicy'@.
53+
pattern DoDiskSnapshotChecksum, NoDoDiskSnapshotChecksum :: Flag "DoDiskSnapshotChecksum"
54+
pattern DoDiskSnapshotChecksum = Flag True
55+
pattern NoDoDiskSnapshotChecksum = Flag False
56+
57+
-- | The components used by cardano-node to construct a @'DiskPolicy'@.
58+
data DiskPolicyArgs = DiskPolicyArgs SnapshotInterval NumOfDiskSnapshots (Flag "DoDiskSnapshotChecksum")
4559

4660
-- | On-disk policy
4761
--
@@ -67,7 +81,7 @@ data DiskPolicy = DiskPolicy {
6781
-- the next snapshot, we delete the oldest one, leaving the middle
6882
-- one available in case of truncation of the write. This is
6983
-- probably a sane value in most circumstances.
70-
onDiskNumSnapshots :: Word
84+
onDiskNumSnapshots :: Word
7185

7286
-- | Should we write a snapshot of the ledger state to disk?
7387
--
@@ -87,7 +101,11 @@ data DiskPolicy = DiskPolicy {
87101
-- blocks had to be replayed.
88102
--
89103
-- See also 'mkDiskPolicy'
90-
, onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
104+
, onDiskShouldTakeSnapshot :: TimeSinceLast DiffTime -> Word64 -> Bool
105+
106+
-- | Whether or not to checksum the ledger snapshots to detect data corruption on disk.
107+
-- "yes" if @'DoDiskSnapshotChecksum'@; "no" if @'NoDoDiskSnapshotChecksum'@.
108+
, onDiskShouldChecksumSnapshots :: Flag "DoDiskSnapshotChecksum"
91109
}
92110
deriving NoThunks via OnlyCheckWhnf DiskPolicy
93111

@@ -97,10 +115,10 @@ data TimeSinceLast time = NoSnapshotTakenYet | TimeSinceLast time
97115
-- | Default on-disk policy arguments suitable to use with cardano-node
98116
--
99117
defaultDiskPolicyArgs :: DiskPolicyArgs
100-
defaultDiskPolicyArgs = DiskPolicyArgs DefaultSnapshotInterval DefaultNumOfDiskSnapshots
118+
defaultDiskPolicyArgs = DiskPolicyArgs DefaultSnapshotInterval DefaultNumOfDiskSnapshots DoDiskSnapshotChecksum
101119

102120
mkDiskPolicy :: SecurityParam -> DiskPolicyArgs -> DiskPolicy
103-
mkDiskPolicy (SecurityParam k) (DiskPolicyArgs reqInterval reqNumOfSnapshots) =
121+
mkDiskPolicy (SecurityParam k) (DiskPolicyArgs reqInterval reqNumOfSnapshots onDiskShouldChecksumSnapshots) =
104122
DiskPolicy {..}
105123
where
106124
onDiskNumSnapshots :: Word

0 commit comments

Comments
 (0)