Hook

Author: jasagredo

cardano-node/app/cardano-node.hs

@@ -81,7 +81,7 @@ main = do
 
 data Command = RunCmd PartialNodeConfiguration
              | TraceDocumentation TraceDocumentationCmd
-             | CanonicalizeSnapshotsCmd FilePath (Maybe NodeDatabasePaths)
+             | CanonicalizeSnapshotsCmd (Maybe FilePath) (Maybe NodeDatabasePaths)
              | VersionCmd
 
 -- Yes! A --version flag or version command. Either guess is right!

cardano-node/cardano-node.cabal

@@ -199,6 +199,7 @@ library
                       , ouroboros-network-protocols ^>= 0.15
                       , prettyprinter
                       , prettyprinter-ansi-terminal
+                      , process
                       , psqueues
                       , random
                       , resource-registry

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -174,6 +174,8 @@ data NodeConfiguration
        , ncGenesisConfig :: GenesisConfig
 
        , ncResponderCoreAffinityPolicy :: ResponderCoreAffinityPolicy
+
+       , ncCanonicalSnapshotOutputPath :: Maybe FilePath
        } deriving (Eq, Show)
 
 -- | We expose the `Ouroboros.Network.Mux.ForkPolicy` as a `NodeConfiguration` field.
@@ -887,6 +889,7 @@ makeNodeConfiguration pnc = do
              , ncConsensusMode
              , ncGenesisConfig
              , ncResponderCoreAffinityPolicy
+             , ncCanonicalSnapshotOutputPath = getLast $ pncCanonicalSnapshotOutputPath pnc
              }
 
 ncProtocol :: NodeConfiguration -> Protocol

cardano-node/src/Cardano/Node/Parsers.hs

@@ -437,13 +437,13 @@ renderHelpDoc :: Int -> OptI.Doc -> String
 renderHelpDoc cols =
   (`OptI.renderShowS` "") . OptI.layoutPretty (OptI.LayoutOptions (OptI.AvailablePerLine cols 1.0))
 
-parseSnapshotsCmd :: Parser (FilePath, Maybe NodeDatabasePaths)
+parseSnapshotsCmd :: Parser (Maybe FilePath, Maybe NodeDatabasePaths)
 parseSnapshotsCmd = subparser
                 (  commandGroup "Canonicalize snapshots"
                 <> metavar "run"
                 <> command "canonicalize-snapshots"
                      (info (((,)
-                             <$> parseConfigFile
+                             <$> optional parseConfigFile
                              <*> optional (parseDbPath <|> fmap OnePathForAllDbs parseImmutableDbPath)
                              ) <**> helper)
                            (progDesc "Canonicalize all snapshots" ))

cardano-node/src/Cardano/Node/Tracing/API.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE PackageImports #-}
@@ -37,7 +38,8 @@ import           Prelude
 
 import           Control.DeepSeq (deepseq)
 import           Control.Monad (forM_)
-import           "contra-tracer" Control.Tracer (traceWith)
+import           "contra-tracer" Control.Tracer (traceWith, Tracer)
+import qualified "contra-tracer" Control.Tracer as CT
 import           "trace-dispatcher" Control.Tracer (nullTracer)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe
@@ -48,7 +50,11 @@ import           System.Metrics as EKG
 
 import           Trace.Forward.Forwarding (initForwardingDelayed)
 import           Trace.Forward.Utils.TraceObject (writeToSink)
-
+import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
+import Ouroboros.Consensus.Util.Enclose
+import qualified Ouroboros.Consensus.Storage.LedgerDB.Snapshots as LedgerDB
+import qualified Ouroboros.Consensus.Storage.LedgerDB.TraceEvent as LedgerDB
+import Cardano.Snapshots.Run
 
 initTraceDispatcher ::
   forall blk.
@@ -69,7 +75,16 @@ initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do
                 (unConfigPath $ ncConfigFile nc)
                 defaultCardanoConfig
 
-  (kickoffForwarder, kickoffPrometheusSimple, tracers) <- mkTracers trConfig
+  let onChainDbEvent = if isJust (ncCanonicalSnapshotOutputPath nc)
+        then CT.Tracer $ \case
+          (ChainDB.TraceLedgerDBEvent
+           (LedgerDB.LedgerDBSnapshotEvent
+            (LedgerDB.TookSnapshot _ _ (FallingEdgeWith _)))
+           ) -> spawnCanonicalizer
+          _ -> pure ()
+        else CT.nullTracer
+
+  (kickoffForwarder, kickoffPrometheusSimple, tracers) <- mkTracers trConfig onChainDbEvent
 
   -- The NodeInfo DataPoint needs to be fully evaluated and stored
   -- before it is queried for the first time by cardano-tracer.
@@ -107,11 +122,12 @@ initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do
 
   mkTracers
     :: TraceConfig
+    -> Tracer IO (ChainDB.TraceEvent blk)
     -> IO ( IO ()
           , IO (Maybe String)
           , Tracers RemoteAddress LocalAddress blk IO
           )
-  mkTracers trConfig = do
+  mkTracers trConfig onChainDbEvent = do
     ekgStore <- EKG.newStore
     EKG.registerGcMetrics ekgStore
     ekgTrace <- ekgTracer trConfig ekgStore
@@ -144,6 +160,7 @@ initTraceDispatcher nc p networkMagic nodeKernel noBlockForging = do
         nodeKernel
         stdoutTrace
         fwdTracer
+        onChainDbEvent
         (Just ekgTrace)
         dpTracer
         trConfig

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -79,13 +79,14 @@ mkDispatchTracers
   => NodeKernelData blk
   -> Trace IO FormattedMessage
   -> Trace IO FormattedMessage
+  -> Tracer IO (ChainDB.TraceEvent blk)
   -> Maybe (Trace IO FormattedMessage)
   -> Trace IO DataPoint
   -> TraceConfig
   -> SomeConsensusProtocol
   -> IO (Tracers RemoteAddress LocalAddress blk IO)
 
-mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig p = do
+mkDispatchTracers nodeKernel trBase trForward onChainDBEventTracer mbTrEKG trDataPoint trConfig p  = do
 
     configReflection <- emptyConfigReflection
 
@@ -175,6 +176,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig p = d
         chainDBTracer = Tracer (traceWith chainDBTr')
                       <> Tracer (traceWith replayBlockTr')
                       <> Tracer (SR.traceNodeStateChainDB p nodeStateDP)
+                      <> onChainDBEventTracer
       , consensusTracers = consensusTr
       , churnModeTracer = Tracer (traceWith churnModeTr)
       , nodeToClientTracers = nodeToClientTr

cardano-node/src/Cardano/Snapshots/Run.hs

@@ -4,26 +4,56 @@
 
 module Cardano.Snapshots.Run (
     canonicalizeSnapshots,
+    spawnCanonicalizer,
     NodeDatabasePaths,
 ) where
 
 import qualified Cardano.Api.Consensus as Api
 import Cardano.Node.Configuration.LedgerDB
 import Cardano.Node.Configuration.POM
+import Cardano.Node.Parsers (nodeCLIParser)
 import Cardano.Node.Protocol
 import Cardano.Node.Types (ConfigYamlFilePath (..))
 import Control.Exception
-import Control.Monad (forM_)
+import Control.Monad (forM_, void)
+import Control.Monad.Class.MonadFork
 import Control.Monad.Except
+import Data.Maybe (fromMaybe)
 import Data.Monoid (Last (..))
+import Options.Applicative
 import Ouroboros.Consensus.Cardano.SnapshotConversion
 import Ouroboros.Consensus.Node (NodeDatabasePaths (..), immutableDbPath)
 import System.Directory (doesFileExist, listDirectory)
+import System.Environment
 import System.FilePath ((</>))
+import System.IO (hPutStrLn, stderr)
+import System.Process
 
-canonicalizeSnapshots :: FilePath -> Maybe NodeDatabasePaths -> IO ()
+spawnCanonicalizer :: IO ()
+spawnCanonicalizer =
+    void $ forkIO $ do
+        putStrLn "SPAWNING"
+        progName <- getExecutablePath
+        putStrLn progName
+        mPnc <- execParserPure defaultPrefs (info nodeCLIParser mempty) <$> getArgs
+        case mPnc of
+            Success pnc -> do
+                let cfg = case getLast $ pncConfigFile pnc of
+                           Nothing -> []
+                           Just (ConfigYamlFilePath cfgFile) -> ["--config", cfgFile]
+                    db = case getLast $ pncDatabaseFile pnc of
+                           Nothing -> []
+                           Just (OnePathForAllDbs p) -> ["--database-path", p]
+                           Just (MultipleDbPaths imm _) -> ["--database-path", imm]
+                (_, out, err) <-
+                    readProcessWithExitCode progName ("canonicalize-snapshots" : cfg ++ db) ""
+                putStrLn out
+                hPutStrLn stderr err
+            _ -> pure ()
+
+canonicalizeSnapshots :: Maybe FilePath -> Maybe NodeDatabasePaths -> IO ()
 canonicalizeSnapshots cfg (Last -> db) = do
-    configYamlPc <- parseNodeConfigurationFP $ Just $ ConfigYamlFilePath cfg
+    configYamlPc <- parseNodeConfigurationFP $ Just $ ConfigYamlFilePath $ fromMaybe "configuration/cardano/mainnet-config.json" cfg
 
     let cfgFromFile = defaultPartialNodeConfiguration <> configYamlPc