Change RequestedInterval to be a data type representing the default a…

…nd set value This adds a bit more readability on the caller side of the defaultDiskPolicy function by introducing a meaningful data constructor
IntersectMBO · Mar 2, 2021 · bb1db87 · bb1db87
1 parent ab9e03b
commit bb1db87
Show file tree

Hide file tree

Showing 6 changed files with 19 additions and 18 deletions.
diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Main.hs b/ouroboros-consensus-cardano/tools/db-analyser/Main.hs
@@ -24,7 +24,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Args (fromChainDbArgs)
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
-                     (defaultDiskPolicy)
+                     (RequestedInterval (..), defaultDiskPolicy)
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 
 import           Analysis
@@ -168,7 +168,7 @@ analyse CmdLine {..} args =
         mkProtocolInfo args
       let chunkInfo  = Node.nodeImmutableDbChunkInfo (configStorage cfg)
           k          = configSecurityParam cfg
-          diskPolicy = defaultDiskPolicy k Nothing
+          diskPolicy = defaultDiskPolicy k DefaultRequestInterval
           args' =
             Node.mkChainDbArgs
               registry InFuture.dontCheck cfg initLedger chunkInfo $

diff --git a/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs b/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs
@@ -703,7 +703,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
         , cdbImmutableDbValidation  = ImmutableDB.ValidateAllChunks
         , cdbVolatileDbValidation   = VolatileDB.ValidateAll
         , cdbMaxBlocksPerFile       = VolatileDB.mkBlocksPerFile 4
-        , cdbDiskPolicy             = LgrDB.defaultDiskPolicy (configSecurityParam cfg) Nothing
+        , cdbDiskPolicy             = LgrDB.defaultDiskPolicy (configSecurityParam cfg) LgrDB.DefaultRequestInterval
           -- Integration
         , cdbTopLevelConfig         = cfg
         , cdbChunkInfo              = ImmutableDB.simpleChunkInfo epochSize0

diff --git a/...boros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs b/...boros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs
@@ -40,7 +40,7 @@ import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB (LgrDB,
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB as LgrDB
 import           Ouroboros.Consensus.Storage.FS.API (HasFS, SomeHasFS (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
-                     (defaultDiskPolicy)
+                     (RequestedInterval (..), defaultDiskPolicy)
 import qualified Ouroboros.Consensus.Storage.LedgerDB.InMemory as LgrDB
                      (ledgerDbPast, ledgerDbTip, ledgerDbWithAnchor)
 
@@ -210,7 +210,7 @@ initLgrDB k chain = do
     args = LgrDbArgs
       { lgrTopLevelConfig       = cfg
       , lgrHasFS                = SomeHasFS (error "lgrHasFS" :: HasFS m ())
-      , lgrDiskPolicy           = defaultDiskPolicy k Nothing
+      , lgrDiskPolicy           = defaultDiskPolicy k DefaultRequestInterval
       , lgrGenesis              = return testInitExtLedger
       , lgrTracer               = nullTracer
       , lgrTraceLedger          = nullTracer

diff --git a/ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -95,7 +95,7 @@ import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
                      (unsafeChunkNoToEpochNo)
 import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
-                     (defaultDiskPolicy)
+                     (RequestedInterval (..), defaultDiskPolicy)
 import           Ouroboros.Consensus.Storage.LedgerDB.InMemory (LedgerDB)
 import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
@@ -1580,7 +1580,7 @@ mkArgs cfg (MaxClockSkew maxClockSkew) chunkInfo initLedger tracer registry varC
     , cdbImmutableDbValidation  = ValidateAllChunks
     , cdbVolatileDbValidation   = VolatileDB.ValidateAll
     , cdbMaxBlocksPerFile       = VolatileDB.mkBlocksPerFile 4
-    , cdbDiskPolicy             = defaultDiskPolicy (configSecurityParam cfg) Nothing
+    , cdbDiskPolicy             = defaultDiskPolicy (configSecurityParam cfg) DefaultRequestInterval
 
       -- Integration
     , cdbTopLevelConfig         = cfg

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node.hs
@@ -110,7 +110,7 @@ import           Ouroboros.Consensus.Storage.FS.IO (ioHasFS)
 import           Ouroboros.Consensus.Storage.ImmutableDB (ChunkInfo,
                      ValidationPolicy (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
-                     (RequestedInterval, defaultDiskPolicy)
+                     (RequestedInterval (..), defaultDiskPolicy)
 import           Ouroboros.Consensus.Storage.VolatileDB
                      (BlockValidationPolicy (..))
 
@@ -614,7 +614,7 @@ data StdRunNodeArgs m blk = StdRunNodeArgs
   , srnBfcMaxConcurrencyDeadline :: Maybe Word
   , srcChainDbValidateOverride   :: Bool
     -- ^ If @True@, validate the ChainDB on init no matter what
-  , srnRequestedInterval         :: Maybe RequestedInterval
+  , srnRequestedInterval         :: RequestedInterval
   , srnDatabasePath              :: FilePath
     -- ^ Location of the DBs
   , srnDiffusionArguments        :: DiffusionArguments

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/DiskPolicy.hs
@@ -19,9 +19,9 @@ import           Control.Monad.Class.MonadTime
 import           Ouroboros.Consensus.Config.SecurityParam
 
 
-newtype RequestedInterval = RequestedInterval
-  { unRequestedInterval :: Word64
-  }
+data RequestedInterval =
+    DefaultRequestInterval
+  | RequestedInterval Word64
 
 -- | On-disk policy
 --
@@ -85,8 +85,8 @@ data DiskPolicy = DiskPolicy {
 -- take a snapshot roughly every @k@ blocks. It does mean the possibility of
 -- an extra unnecessary snapshot during syncing (if the node is restarted), but
 -- that is not a big deal.
-defaultDiskPolicy :: SecurityParam -> Maybe RequestedInterval -> DiskPolicy
-defaultDiskPolicy (SecurityParam k) maybeRequestedInterval = DiskPolicy {..}
+defaultDiskPolicy :: SecurityParam -> RequestedInterval -> DiskPolicy
+defaultDiskPolicy (SecurityParam k) requestedInterval = DiskPolicy {..}
   where
     onDiskNumSnapshots :: Word
     onDiskNumSnapshots = 2
@@ -97,12 +97,13 @@ defaultDiskPolicy (SecurityParam k) maybeRequestedInterval = DiskPolicy {..}
       -> Bool
     onDiskShouldTakeSnapshot Nothing blocksSinceLast = blocksSinceLast >= k
     onDiskShouldTakeSnapshot (Just timeSinceLast) blocksSinceLast =
-      let snapshotIntervalSeconds      =
-            maybe (k * 2) unRequestedInterval maybeRequestedInterval
-          snapshotInterval             =
-            secondsToDiffTime (fromIntegral snapshotIntervalSeconds)
+      let snapshotIntervalSeconds      = fromIntegral $ interval requestedInterval
+          snapshotInterval             = secondsToDiffTime snapshotIntervalSeconds
           itsBeen50kBlocks             = blocksSinceLast >= 50_000
           itsBeen6MinSinceLastSnapshot = timeSinceLast > 6 * secondsToDiffTime 60
       in
            timeSinceLast >= snapshotInterval
         || itsBeen50kBlocks && itsBeen6MinSinceLastSnapshot
+
+    interval (RequestedInterval value) = value
+    interval DefaultRequestInterval    = k * 2