Add snapshot interval to the configuration of the node

IntersectMBO · Apr 30, 2021 · 5654860 · 5654860
1 parent 487e023
commit 5654860
Show file tree

Hide file tree

Showing 6 changed files with 50 additions and 10 deletions.
diff --git a/cabal.project b/cabal.project
@@ -100,8 +100,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 101e7752cf4b23fd0b411736f523b8f6c43f6bc2
-  --sha256: 04qnq9a3mhfqsisln2sygfm0xkkvj8f8hdzxm1qn2ss0mfsfzx8y
+  tag: 4251c0bb6e4f443f00231d28f5f70d42876da055
+  --sha256: 02a61ymvx054pcdcgvg5qj9kpybiajg993nr22iqiya196jmgciv
   subdir:
     binary
     binary/test
@@ -119,8 +119,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 0730828363ad6d0669b7a5a12635e22944b32880
-  --sha256: 099j8xcmhlfqz5p8qpxsxixzlb06zmxxl7yqd06dkr96gbjd2npz
+  tag: 653dadcc70cd6456784f597866dd44a952cfbfb9
+  --sha256: 03dc6qf9w5xi8psz6sd14w7y1fa6dxf356c0nfp1q8qlg8ndix1r
   subdir:
     byron/chain/executable-spec
     byron/crypto
@@ -134,6 +134,7 @@ source-repository-package
     shelley/chain-and-ledger/executable-spec
     shelley/chain-and-ledger/shelley-spec-ledger-test
     shelley-ma/impl
+    shelley-ma/shelley-ma-test
 
 source-repository-package
   type: git
@@ -174,8 +175,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 66dd5eb0f4bf20272e30a8c5c0a0c9d3992de039
-  --sha256: 1z23l4l81afdzmsh0bgs4ivg0nv58l4mp7g25qa4nfsczl6j07cf
+  tag: ec79b87254589276e75f11ea95c069266b7b151d
+  --sha256: 1j8dzx1x3nbxwahbm3nv6l8k9my1f9sw0ppccdkq7kdb75qzvyag
   subdir:
     io-sim
     io-sim-classes
@@ -186,6 +187,7 @@ source-repository-package
     ouroboros-consensus-shelley
     ouroboros-network
     ouroboros-network-framework
+    ouroboros-network-testing
     typed-protocols
     typed-protocols-examples
 

diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -183,7 +183,9 @@ test-suite cardano-node-test
                       , hedgehog
                       , hedgehog-corpus
                       , iproute
+                      , ouroboros-consensus
                       , ouroboros-network
+                      , time
 
   other-modules:        Test.Cardano.Node.FilePermissions
                         Test.Cardano.Node.Gen

diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}
+{-# OPTIONS_GHC -Wno-orphans            #-}
 
 module Cardano.Node.Configuration.POM
   ( NodeConfiguration (..)
@@ -35,6 +37,10 @@ import           Cardano.Node.Types
 import           Cardano.Tracing.Config
 import           Ouroboros.Network.Block (MaxSlotNo (..))
 import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
+import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
+
+deriving instance Eq SnapshotInterval
+deriving instance Generic SnapshotInterval
 
 data NodeConfiguration
   = NodeConfiguration
@@ -56,8 +62,9 @@ data NodeConfiguration
        , ncProtocolConfig :: !NodeProtocolConfiguration
 
          -- Node parameters, not protocol-specific:
-       , ncSocketPath     :: !(Maybe SocketPath)
-       , ncDiffusionMode  :: !DiffusionMode
+       , ncSocketPath       :: !(Maybe SocketPath)
+       , ncDiffusionMode    :: !DiffusionMode
+       , ncSnapshotInterval :: !SnapshotInterval
 
          -- BlockFetch configuration
        , ncMaxConcurrencyBulkSync :: !(Maybe MaxConcurrencyBulkSync)
@@ -90,8 +97,9 @@ data PartialNodeConfiguration
        , pncProtocolConfig :: !(Last NodeProtocolConfiguration)
 
          -- Node parameters, not protocol-specific:
-       , pncSocketPath     :: !(Last SocketPath)
-       , pncDiffusionMode  :: !(Last DiffusionMode)
+       , pncSocketPath       :: !(Last SocketPath)
+       , pncDiffusionMode    :: !(Last DiffusionMode)
+       , pncSnapshotInterval :: !(Last SnapshotInterval)
 
          -- BlockFetch configuration
        , pncMaxConcurrencyBulkSync :: !(Last MaxConcurrencyBulkSync)
@@ -120,6 +128,8 @@ instance FromJSON PartialNodeConfiguration where
       pncSocketPath' <- Last <$> v .:? "SocketPath"
       pncDiffusionMode'
         <- Last . fmap getDiffusionMode <$> v .:? "DiffusionMode"
+      pncSnapshotInterval'
+        <- Last . fmap RequestedSnapshotInterval <$> v .:? "SnapshotInterval"
 
       -- Blockfetch parameters
       pncMaxConcurrencyBulkSync' <- Last <$> v .:? "MaxConcurrencyBulkSync"
@@ -150,6 +160,7 @@ instance FromJSON PartialNodeConfiguration where
              pncProtocolConfig = pncProtocolConfig'
            , pncSocketPath = pncSocketPath'
            , pncDiffusionMode = pncDiffusionMode'
+           , pncSnapshotInterval = pncSnapshotInterval'
            , pncMaxConcurrencyBulkSync = pncMaxConcurrencyBulkSync'
            , pncMaxConcurrencyDeadline = pncMaxConcurrencyDeadline'
            , pncLoggingSwitch = Last $ Just pncLoggingSwitch'
@@ -250,6 +261,7 @@ defaultPartialNodeConfiguration =
     , pncLoggingSwitch = Last $ Just True
     , pncSocketPath = mempty
     , pncDiffusionMode = Last $ Just InitiatorAndResponderDiffusionMode
+    , pncSnapshotInterval = Last $ Just DefaultSnapshotInterval
     , pncTopologyFile = Last . Just $ TopologyFile "configuration/cardano/mainnet-topology.json"
     , pncNodeIPv4Addr = mempty
     , pncNodeIPv6Addr = mempty
@@ -285,6 +297,8 @@ makeNodeConfiguration pnc = do
   logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc
   traceConfig <- lastToEither "Missing TraceConfig" $ pncTraceConfig pnc
   diffusionMode <- lastToEither "Missing DiffusionMode" $ pncDiffusionMode pnc
+  snapshotInterval <- lastToEither "Missing SnapshotInterval" $ pncSnapshotInterval pnc
+
   return $ NodeConfiguration
              { ncNodeIPv4Addr = getLast $ pncNodeIPv4Addr pnc
              , ncNodeIPv6Addr = getLast $ pncNodeIPv6Addr pnc
@@ -299,6 +313,7 @@ makeNodeConfiguration pnc = do
              , ncProtocolConfig = protocolConfig
              , ncSocketPath = getLast $ pncSocketPath pnc
              , ncDiffusionMode = diffusionMode
+             , ncSnapshotInterval = snapshotInterval
              , ncMaxConcurrencyBulkSync = getLast $ pncMaxConcurrencyBulkSync pnc
              , ncMaxConcurrencyDeadline = getLast $ pncMaxConcurrencyDeadline pnc
              , ncLoggingSwitch = loggingSwitch

diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs
@@ -11,13 +11,16 @@ module Cardano.Node.Parsers
 import           Cardano.Prelude hiding (option)
 import           Prelude (String)
 
+import           Data.Time.Clock (secondsToDiffTime)
 import           Options.Applicative hiding (str)
 import qualified Options.Applicative as Opt
 import qualified Options.Applicative.Help as OptI
 import           System.Posix.Types (Fd (..))
 
 import           Ouroboros.Network.Block (MaxSlotNo (..), SlotNo (..))
 
+import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
+
 import           Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption)
 import           Cardano.Node.Types
 
@@ -52,6 +55,7 @@ nodeRunParser = do
 
   -- NodeConfiguration filepath
   nodeConfigFp <- lastOption parseConfigFile
+  snapshotInterval <- lastOption parseSnapshotInterval
 
   validate <- lastOption parseValidateDB
   shutdownIPC <- lastOption parseShutdownIPC
@@ -67,6 +71,7 @@ nodeRunParser = do
            , pncDatabaseFile = DbFile <$> dbFp
            , pncSocketPath   = socketFp
            , pncDiffusionMode = mempty
+           , pncSnapshotInterval = snapshotInterval
            , pncProtocolFiles = Last $ Just ProtocolFilepaths
              { byronCertFile
              , byronKeyFile
@@ -253,6 +258,15 @@ parseVrfKeyFilePath =
         <> completer (bashCompleter "file")
     )
 
+-- TODO revisit because it sucks
+parseSnapshotInterval :: Parser SnapshotInterval
+parseSnapshotInterval = fmap (RequestedSnapshotInterval . secondsToDiffTime) parseDifftime
+  where
+  parseDifftime = option auto
+    ( long "snapshot-interval"
+        <> metavar "SNAPSHOTINTERVAL"
+        <> help "Snapshot Interval (in second)"
+    )
 
 -- | Produce just the brief help header for a given CLI option parser,
 --   without the options.

diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
@@ -285,6 +285,7 @@ handleSimpleNode scp runP trace nodeTracers nc onKernel = do
        { srnBfcMaxConcurrencyBulkSync   = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
        , srnBfcMaxConcurrencyDeadline   = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
        , srnChainDbValidateOverride     = ncValidateDB nc
+       , srnSnapshotInterval            = ncSnapshotInterval nc
        , srnDatabasePath                = dbPath
        , srnDiffusionArguments          = diffusionArguments
        , srnDiffusionTracers            = diffusionTracers

diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs
@@ -7,11 +7,14 @@ module Test.Cardano.Node.POM
 
 import           Cardano.Prelude
 
+import           Data.Time.Clock (secondsToDiffTime)
+
 import           Cardano.Node.Configuration.POM
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config (TraceOptions (..))
 import           Ouroboros.Network.Block (MaxSlotNo (..), SlotNo (..))
 import           Ouroboros.Network.NodeToNode (DiffusionMode (InitiatorAndResponderDiffusionMode))
+import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..))
 
 import           Hedgehog (Property, discover, withTests, (===))
 import qualified Hedgehog
@@ -45,6 +48,7 @@ testPartialYamlConfig =
                             (GenesisFile "dummmy-genesis-file") Nothing
     , pncSocketPath = Last Nothing
     , pncDiffusionMode = Last Nothing
+    , pncSnapshotInterval = mempty
     , pncMaxConcurrencyBulkSync = Last Nothing
     , pncMaxConcurrencyDeadline = Last Nothing
     , pncLoggingSwitch = Last $ Just True
@@ -75,6 +79,7 @@ testPartialCliConfig =
     , pncDatabaseFile = mempty
     , pncSocketPath   = mempty
     , pncDiffusionMode = mempty
+    , pncSnapshotInterval = Last . Just . RequestedSnapshotInterval $ secondsToDiffTime 100
     , pncProtocolFiles = Last . Just $ ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
     , pncValidateDB = Last $ Just True
     , pncShutdownIPC = Last $ Just Nothing
@@ -106,6 +111,7 @@ expectedConfig =
                              (GenesisFile "dummmy-genesis-file") Nothing
     , ncSocketPath = Nothing
     , ncDiffusionMode = InitiatorAndResponderDiffusionMode
+    , ncSnapshotInterval = RequestedSnapshotInterval $ secondsToDiffTime 100
     , ncMaxConcurrencyBulkSync = Nothing
     , ncMaxConcurrencyDeadline = Nothing
     , ncLoggingSwitch = True