diff --git a/cabal.project b/cabal.project index 33c782f5396..ffd50a72257 100644 --- a/cabal.project +++ b/cabal.project @@ -108,3 +108,10 @@ if impl(ghc >= 9.12) proto-lens-tests-dep proto-lens-tests proto-lens + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 3c557b3d997709e92ddcee055b415227d0c4a82d + --sha256: sha256-z9ADSqguJFPzIjFaNk4sj+AHMeRPW6ZC52miuUMEqTA= + subdir: . diff --git a/cardano-node/src/Cardano/Node/Configuration/LedgerDB.hs b/cardano-node/src/Cardano/Node/Configuration/LedgerDB.hs index 2c60b7e9d87..d4e2179b873 100644 --- a/cardano-node/src/Cardano/Node/Configuration/LedgerDB.hs +++ b/cardano-node/src/Cardano/Node/Configuration/LedgerDB.hs @@ -73,8 +73,7 @@ noDeprecatedOptions = DeprecatedOptions [] data LedgerDbConfiguration = LedgerDbConfiguration - NumOfDiskSnapshots - SnapshotInterval + SnapshotPolicyArgs QueryBatchSize LedgerDbSelectorFlag DeprecatedOptions diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 980b30003ba..3405156f2a4 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -28,6 +28,7 @@ module Cardano.Node.Configuration.POM where import Cardano.Crypto (RequiresNetworkMagic (..)) +import Cardano.Ledger.BaseTypes import Cardano.Logging.Types import Cardano.Network.ConsensusMode (ConsensusMode (..), defaultConsensusMode) import qualified Cardano.Network.Diffusion.Configuration as Cardano @@ -48,7 +49,9 @@ import Ouroboros.Consensus.Node.Genesis (GenesisConfig, GenesisConfigF defaultGenesisConfigFlags, mkGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.Args (QueryBatchSize (..)) import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..), - SnapshotInterval (..)) + SnapshotDelayRange (..), SnapshotFrequency (..), SnapshotFrequencyArgs (..), + SnapshotPolicyArgs (..), defaultSnapshotPolicyArgs) +import Ouroboros.Consensus.Util.Args (OverrideOrDefault (..)) import Ouroboros.Consensus.Storage.LedgerDB.V1.Args (FlushFrequency (..)) import Ouroboros.Network.Diffusion.Configuration as Configuration import qualified Ouroboros.Network.Diffusion.Configuration as Ouroboros @@ -510,8 +513,14 @@ instance FromJSON PartialNodeConfiguration where Nothing -> return Nothing parseLedgerDbConfig v = do - let snapInterval x = fmap (RequestedSnapshotInterval . secondsToDiffTime) <$> x .:? "SnapshotInterval" - snapNum x = fmap RequestedNumOfDiskSnapshots <$> x .:? "NumOfDiskSnapshots" + -- TODO maybe don't silently convert old format (which was in seconds) + -- to new format (which is in slots), despite these being the same on + -- mainnet? + let snapInterval x = do + si <- x .:? "SnapshotInterval" + when (any (<= 0) si) $ fail $ "Non-positive SnapshotInterval: " <> show si + pure $ Override . SlotNo <$> si + snapNum x = fmap (Override . NumOfDiskSnapshots) <$> x .:? "NumOfDiskSnapshots" mTopLevelSnapInterval <- snapInterval v mTopLevelSnapNum <- snapNum v @@ -525,12 +534,32 @@ instance FromJSON PartialNodeConfiguration where mLedgerDB <- v .:? "LedgerDB" case mLedgerDB of Nothing -> do - let si = fromMaybe DefaultSnapshotInterval mTopLevelSnapInterval - sn = fromMaybe DefaultNumOfDiskSnapshots mTopLevelSnapNum - return $ Just $ LedgerDbConfiguration sn si DefaultQueryBatchSize V2InMemory deprecatedOpts + let si = fromMaybe UseDefault mTopLevelSnapInterval + sn = fromMaybe UseDefault mTopLevelSnapNum + sf = SnapshotFrequencyArgs { + sfaInterval = unsafeNonZero . unSlotNo <$> si + , sfaOffset = UseDefault + , sfaRateLimit = UseDefault + , sfaDelaySnapshotRange = UseDefault + } + spArgs = SnapshotPolicyArgs (SnapshotFrequency sf) sn + return $ Just $ LedgerDbConfiguration spArgs DefaultQueryBatchSize V2InMemory deprecatedOpts Just ledgerDB -> flip (withObject "LedgerDB") ledgerDB $ \o -> do - ldbSnapInterval <- (getLast . (Last mTopLevelSnapInterval <>) . Last <$> snapInterval o) .!= DefaultSnapshotInterval - ldbSnapNum <- (getLast . (Last mTopLevelSnapNum <>) . Last <$> snapNum o) .!= DefaultNumOfDiskSnapshots + ldbSnapInterval <- (getLast . (Last mTopLevelSnapInterval <>) . Last <$> snapInterval o) .!= UseDefault + ldbSnapNum <- (getLast . (Last mTopLevelSnapNum <>) . Last <$> snapNum o) .!= UseDefault + ldbSnapOffset <- (fmap Override <$> o .:? "SlotOffset") .!= UseDefault + ldbSnapRateLimit<- (fmap (Override . secondsToDiffTime) <$> o .:? "RateLimit") .!= UseDefault + ldbSnapMinDelay <- o .:? "MinDelay" + ldbSnapMaxDelay <- o .:? "MaxDelay" + ldbSnapDelayRange <- + case (ldbSnapMinDelay, ldbSnapMaxDelay) of + (Just minDelay, Just maxDelay) -> + if minDelay <= maxDelay then + pure (Override (SnapshotDelayRange (secondsToDiffTime minDelay) (secondsToDiffTime maxDelay))) + else fail $ "Invalid ledger snapshot delay range, MinDelay > MaxDelay: " + <> show minDelay <> " > " <> show maxDelay + -- use the default delay range if either min or max is unspecified + _ -> pure UseDefault qsize <- (fmap RequestedQueryBatchSize <$> o .:? "QueryBatchSize") .!= DefaultQueryBatchSize backend <- o .:? "Backend" .!= "V2InMemory" selector <- case backend of @@ -545,7 +574,14 @@ instance FromJSON PartialNodeConfiguration where lsmPath :: Maybe FilePath <- o .:? "LSMDatabasePath" pure $ V2LSM lsmPath _ -> fail $ "Malformed LedgerDB Backend: " <> backend - pure $ Just $ LedgerDbConfiguration ldbSnapNum ldbSnapInterval qsize selector deprecatedOpts + let sf = SnapshotFrequencyArgs { + sfaInterval = unsafeNonZero . unSlotNo <$> ldbSnapInterval + , sfaOffset = ldbSnapOffset + , sfaRateLimit = ldbSnapRateLimit + , sfaDelaySnapshotRange = ldbSnapDelayRange + } + spArgs = SnapshotPolicyArgs (SnapshotFrequency sf) ldbSnapNum + pure $ Just $ LedgerDbConfiguration spArgs qsize selector deprecatedOpts parseByronProtocol v = do primary <- v .:? "ByronGenesisFile" @@ -712,8 +748,7 @@ defaultPartialNodeConfiguration = , pncLedgerDbConfig = Last $ Just $ LedgerDbConfiguration - DefaultNumOfDiskSnapshots - DefaultSnapshotInterval + defaultSnapshotPolicyArgs DefaultQueryBatchSize V2InMemory noDeprecatedOptions diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 5298d926c9d..55f62cafc8a 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -656,15 +656,11 @@ handleSimpleNode blockType runP tracers nc networkMagic onKernel = do Just version_ -> Map.takeWhileAntitone (<= version_) LedgerDbConfiguration - snapInterval - numSnaps + snapshotPolicyArgs queryBatchSize ldbBackend deprecatedOpts = ncLedgerDbConfig nc - snapshotPolicyArgs :: SnapshotPolicyArgs - snapshotPolicyArgs = SnapshotPolicyArgs numSnaps snapInterval - -------------------------------------------------------------------------------- -- SIGHUP Handlers -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 0e2a0dfa947..917f2393201 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -49,6 +49,7 @@ import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as V2 import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM import qualified Ouroboros.Consensus.Storage.PerasCertDB.Impl as PerasCertDB +import qualified Ouroboros.Consensus.Storage.PerasVoteDB.Impl as PerasVoteDB import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB import Ouroboros.Consensus.TypeFamilyWrappers import Ouroboros.Consensus.Util.Condense (condense) @@ -59,6 +60,7 @@ import Ouroboros.Network.Block (MaxSlotNo (..)) import Data.Aeson (Object, Value (String), object, toJSON, (.=)) import qualified Data.ByteString.Base16 as B16 import Data.Int (Int64) +import qualified Data.List.NonEmpty as NonEmpty import Data.SOP (All, K (..), hcmap, hcollapse) import Data.Text (Text) import qualified Data.Text as Text @@ -121,6 +123,7 @@ instance ( LogFormatting (Header blk) ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> "Chain Selection was unstarved by " <> renderRealPoint pt forHuman (ChainDB.TracePerasCertDbEvent ev) = forHuman ev + forHuman (ChainDB.TracePerasVoteDbEvent ev) = forHuman ev forHuman (ChainDB.TraceAddPerasCertEvent ev) = forHuman ev forMachine _ ChainDB.TraceLastShutdownUnclean = @@ -153,6 +156,8 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TracePerasCertDbEvent v) = forMachine details v + forMachine details (ChainDB.TracePerasVoteDbEvent v) = + forMachine details v forMachine details (ChainDB.TraceAddPerasCertEvent v) = forMachine details v @@ -170,6 +175,7 @@ instance ( LogFormatting (Header blk) asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v asMetrics (ChainDB.TracePerasCertDbEvent v) = asMetrics v + asMetrics (ChainDB.TracePerasVoteDbEvent v) = asMetrics v asMetrics (ChainDB.TraceAddPerasCertEvent v) = asMetrics v @@ -200,6 +206,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "VolatileDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TracePerasCertDbEvent ev) = nsPrependInner "PerasCertDbEvent" (namespaceFor ev) + namespaceFor (ChainDB.TracePerasVoteDbEvent ev) = + nsPrependInner "PerasVoteDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceAddPerasCertEvent ev) = nsPrependInner "AddPerasCertEvent" (namespaceFor ev) @@ -249,6 +257,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("PerasCertDbEvent" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (PerasCertDB.TraceEvent blk)) Nothing + severityFor (Namespace out ("PerasVoteDbEvent" : tl)) (Just (ChainDB.TracePerasVoteDbEvent ev')) = + severityFor (Namespace out tl) (Just ev') + severityFor (Namespace out ("PerasVoteDbEvent" : tl)) Nothing = + severityFor (Namespace out tl :: Namespace (PerasVoteDB.TraceEvent blk)) Nothing severityFor (Namespace out ("AddPerasCertEvent" : tl)) (Just (ChainDB.TraceAddPerasCertEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("AddPerasCertEvent" : tl)) Nothing = @@ -301,6 +313,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("PerasCertDbEvent" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (PerasCertDB.TraceEvent blk)) Nothing + privacyFor (Namespace out ("PerasVoteDbEvent" : tl)) (Just (ChainDB.TracePerasVoteDbEvent ev')) = + privacyFor (Namespace out tl) (Just ev') + privacyFor (Namespace out ("PerasVoteDbEvent" : tl)) Nothing = + privacyFor (Namespace out tl :: Namespace (PerasVoteDB.TraceEvent blk)) Nothing privacyFor (Namespace out ("AddPerasCertEvent" : tl)) (Just (ChainDB.TraceAddPerasCertEvent ev')) = privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("AddPerasCertEvent" : tl)) Nothing = @@ -353,6 +369,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("PerasCertDbEvent" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (PerasCertDB.TraceEvent blk)) Nothing + detailsFor (Namespace out ("PerasVoteDbEvent" : tl)) (Just (ChainDB.TracePerasVoteDbEvent ev')) = + detailsFor (Namespace out tl) (Just ev') + detailsFor (Namespace out ("PerasVoteDbEvent" : tl)) Nothing = + detailsFor (Namespace out tl :: Namespace (PerasVoteDB.TraceEvent blk)) Nothing detailsFor (Namespace out ("AddPerasCertEvent" : tl)) (Just (ChainDB.TraceAddPerasCertEvent ev')) = detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("AddPerasCertEvent" : tl)) Nothing = @@ -412,6 +432,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where documentFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) documentFor (Namespace out ("PerasCertDbEvent" : tl)) = documentFor (Namespace out tl :: Namespace (PerasCertDB.TraceEvent blk)) + documentFor (Namespace out ("PerasVoteDbEvent" : tl)) = + documentFor (Namespace out tl :: Namespace (PerasVoteDB.TraceEvent blk)) documentFor (Namespace out ("AddPerasCertEvent" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TraceAddPerasCertEvent blk)) documentFor _ = Nothing @@ -441,6 +463,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where (allNamespaces :: [Namespace (VolDB.TraceEvent blk)]) ++ map (nsPrependInner "PerasCertDbEvent") (allNamespaces :: [Namespace (PerasCertDB.TraceEvent blk)]) + ++ map (nsPrependInner "PerasVoteDbEvent") + (allNamespaces :: [Namespace (PerasVoteDB.TraceEvent blk)]) ++ map (nsPrependInner "AddPerasCertEvent") (allNamespaces :: [Namespace (ChainDB.TraceAddPerasCertEvent blk)]) ) @@ -1749,6 +1773,14 @@ instance ( StandardHash blk LedgerDB.MetadataBackendMismatch -> " Snapshot was created for a different backend. Convert it with `snapshot-converter`." _ -> "" + forHuman (LedgerDB.SnapshotRequestDelayed _snapshotRequestTime delayBeforeSnapshotting slots) = + Text.unwords ["Scheduling to take ledger state snapshots at slots " + , showT (NonEmpty.toList slots) + , ", with a randomised delay of" + , showT delayBeforeSnapshotting + ] + forHuman (LedgerDB.SnapshotRequestCompleted) = "Completed taking a ledger state snapshot" + forMachine dtals (LedgerDB.TookSnapshot snap pt enclosedTiming) = mconcat [ "kind" .= String "TookSnapshot" @@ -1763,11 +1795,23 @@ instance ( StandardHash blk mconcat [ "kind" .= String "InvalidSnapshot" , "snapshot" .= forMachine dtals snap , "failure" .= show failure ] + forMachine _dtals (LedgerDB.SnapshotRequestDelayed snapshotRequestTime delayBeforeSnapshotting slots) = + mconcat [ "kind" .= String "TraceLedgerDBEvent.LedgerDBSnapshotEvent.SnapshotRequestDelayed" + , "requestTime" .= show snapshotRequestTime + , "delayBeforeSnapshotting " .= show delayBeforeSnapshotting + , "slots" .= show slots + ] + forMachine _dtals (LedgerDB.SnapshotRequestCompleted) = + mconcat [ "kind" .= String "TraceLedgerDBEvent.LedgerDBSnapshotEvent.SnapshotRequestCompleted" + ] + instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where namespaceFor LedgerDB.TookSnapshot {} = Namespace [] ["TookSnapshot"] namespaceFor LedgerDB.DeletedSnapshot {} = Namespace [] ["DeletedSnapshot"] namespaceFor LedgerDB.InvalidSnapshot {} = Namespace [] ["InvalidSnapshot"] + namespaceFor LedgerDB.SnapshotRequestDelayed {} = Namespace [] ["SnapshotRequestDelayed"] + namespaceFor LedgerDB.SnapshotRequestCompleted {} = Namespace [] ["SnapshotRequestCompleted"] severityFor (Namespace _ ["TookSnapshot"]) _ = Just Info severityFor (Namespace _ ["DeletedSnapshot"]) _ = Just Debug @@ -1786,6 +1830,10 @@ instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where , " seems to be from an old node or different backend, it will" , " be deleted" ] + documentFor (Namespace _ ["SnapshotRequestDelayed"]) = Just + "A delayed snapshot requested was issued. The snapshot will be initiated at the specified timestamp, with the specified delay and for the specified slots" + documentFor (Namespace _ ["SnapshotRequestCompleted"]) = Just + "The delayed snapshot request was completed" documentFor _ = Nothing allNamespaces = @@ -3084,25 +3132,35 @@ instance (Show (PBFT.PBftVerKeyHash c)) -- PerasCertDB.TraceEvent instances instance LogFormatting (PerasCertDB.TraceEvent blk) where - forHuman (PerasCertDB.AddedPerasCert _cert _peer) = "Added Peras certificate to database" - forHuman (PerasCertDB.IgnoredCertAlreadyInDB _cert _peer) = "Ignored Peras certificate already in database" - forHuman PerasCertDB.OpenedPerasCertDB = "Opened Peras certificate database" - forHuman PerasCertDB.ClosedPerasCertDB = "Closed Peras certificate database" - forHuman (PerasCertDB.AddingPerasCert _cert _peer) = "Adding Peras certificate to database" - - forMachine _dtal (PerasCertDB.AddedPerasCert cert _peer) = - mconcat ["kind" .= String "AddedPerasCert", - "cert" .= String (Text.pack $ show cert)] - forMachine _dtal (PerasCertDB.IgnoredCertAlreadyInDB cert _peer) = - mconcat ["kind" .= String "IgnoredCertAlreadyInDB", - "cert" .= String (Text.pack $ show cert)] - forMachine _dtal PerasCertDB.OpenedPerasCertDB = - mconcat ["kind" .= String "OpenedPerasCertDB"] - forMachine _dtal PerasCertDB.ClosedPerasCertDB = - mconcat ["kind" .= String "ClosedPerasCertDB"] - forMachine _dtal (PerasCertDB.AddingPerasCert cert _peer) = - mconcat ["kind" .= String "AddingPerasCert", - "cert" .= String (Text.pack $ show cert)] + forHuman (PerasCertDB.AddCert roundNo _cert result) = + "Peras certificate for round " <> Text.pack (show roundNo) <> ": " <> Text.pack (show result) + forHuman (PerasCertDB.GarbageCollected slotNo) = + "Peras certificate DB garbage collected at slot " <> Text.pack (show slotNo) + + forMachine _dtal (PerasCertDB.AddCert roundNo _cert result) = + mconcat ["kind" .= String "AddCert", + "round" .= String (Text.pack $ show roundNo), + "result" .= String (Text.pack $ show result)] + forMachine _dtal (PerasCertDB.GarbageCollected slotNo) = + mconcat ["kind" .= String "GarbageCollected", + "slot" .= String (Text.pack $ show slotNo)] + + asMetrics _ = [] + +-- PerasVoteDB.TraceEvent instances +instance StandardHash blk => LogFormatting (PerasVoteDB.TraceEvent blk) where + forHuman (PerasVoteDB.AddVote voteId _vote result) = + "Peras vote " <> Text.pack (show voteId) <> ": " <> Text.pack (show result) + forHuman (PerasVoteDB.GarbageCollected slotNo) = + "Peras vote DB garbage collected at slot " <> Text.pack (show slotNo) + + forMachine _dtal (PerasVoteDB.AddVote voteId _vote result) = + mconcat ["kind" .= String "AddVote", + "voteId" .= String (Text.pack $ show voteId), + "result" .= String (Text.pack $ show result)] + forMachine _dtal (PerasVoteDB.GarbageCollected slotNo) = + mconcat ["kind" .= String "GarbageCollected", + "slot" .= String (Text.pack $ show slotNo)] asMetrics _ = [] @@ -3164,51 +3222,57 @@ instance ConvertRawHash blk => LogFormatting (ChainDB.TraceAddPerasCertEvent blk -- PerasCertDB.TraceEvent MetaTrace instance instance MetaTrace (PerasCertDB.TraceEvent blk) where - namespaceFor (PerasCertDB.AddedPerasCert _ _) = - Namespace [] ["AddedPerasCert"] - namespaceFor (PerasCertDB.IgnoredCertAlreadyInDB _ _) = - Namespace [] ["IgnoredCertAlreadyInDB"] - namespaceFor PerasCertDB.OpenedPerasCertDB = - Namespace [] ["OpenedPerasCertDB"] - namespaceFor PerasCertDB.ClosedPerasCertDB = - Namespace [] ["ClosedPerasCertDB"] - namespaceFor (PerasCertDB.AddingPerasCert _ _) = - Namespace [] ["AddingPerasCert"] - - severityFor (Namespace _ ["AddedPerasCert"]) _ = Just Info - severityFor (Namespace _ ["IgnoredCertAlreadyInDB"]) _ = Just Info - severityFor (Namespace _ ["OpenedPerasCertDB"]) _ = Just Info - severityFor (Namespace _ ["ClosedPerasCertDB"]) _ = Just Info - severityFor (Namespace _ ["AddingPerasCert"]) _ = Just Debug + namespaceFor (PerasCertDB.AddCert _ _ _) = + Namespace [] ["AddCert"] + namespaceFor (PerasCertDB.GarbageCollected _) = + Namespace [] ["GarbageCollected"] + + severityFor (Namespace _ ["AddCert"]) _ = Just Info + severityFor (Namespace _ ["GarbageCollected"]) _ = Just Debug + severityFor _ _ = Nothing + + privacyFor (Namespace _ ["AddCert"]) _ = Just Public + privacyFor (Namespace _ ["GarbageCollected"]) _ = Just Public + privacyFor _ _ = Nothing + + detailsFor (Namespace _ ["AddCert"]) _ = Just DNormal + detailsFor (Namespace _ ["GarbageCollected"]) _ = Just DNormal + detailsFor _ _ = Nothing + + documentFor (Namespace _ ["AddCert"]) = Just "Certificate added to Peras certificate database" + documentFor (Namespace _ ["GarbageCollected"]) = Just "Garbage collection performed on Peras certificate database" + documentFor _ = Nothing + + allNamespaces = + [Namespace [] ["AddCert"], + Namespace [] ["GarbageCollected"]] + +-- PerasVoteDB.TraceEvent MetaTrace instance +instance MetaTrace (PerasVoteDB.TraceEvent blk) where + namespaceFor (PerasVoteDB.AddVote _ _ _) = + Namespace [] ["AddVote"] + namespaceFor (PerasVoteDB.GarbageCollected _) = + Namespace [] ["GarbageCollected"] + + severityFor (Namespace _ ["AddVote"]) _ = Just Info + severityFor (Namespace _ ["GarbageCollected"]) _ = Just Debug severityFor _ _ = Nothing - privacyFor (Namespace _ ["AddedPerasCert"]) _ = Just Public - privacyFor (Namespace _ ["IgnoredCertAlreadyInDB"]) _ = Just Public - privacyFor (Namespace _ ["OpenedPerasCertDB"]) _ = Just Public - privacyFor (Namespace _ ["ClosedPerasCertDB"]) _ = Just Public - privacyFor (Namespace _ ["AddingPerasCert"]) _ = Just Public + privacyFor (Namespace _ ["AddVote"]) _ = Just Public + privacyFor (Namespace _ ["GarbageCollected"]) _ = Just Public privacyFor _ _ = Nothing - detailsFor (Namespace _ ["AddedPerasCert"]) _ = Just DNormal - detailsFor (Namespace _ ["IgnoredCertAlreadyInDB"]) _ = Just DNormal - detailsFor (Namespace _ ["OpenedPerasCertDB"]) _ = Just DNormal - detailsFor (Namespace _ ["ClosedPerasCertDB"]) _ = Just DNormal - detailsFor (Namespace _ ["AddingPerasCert"]) _ = Just DDetailed + detailsFor (Namespace _ ["AddVote"]) _ = Just DNormal + detailsFor (Namespace _ ["GarbageCollected"]) _ = Just DNormal detailsFor _ _ = Nothing - documentFor (Namespace _ ["AddedPerasCert"]) = Just "Certificate added to Peras certificate database" - documentFor (Namespace _ ["IgnoredCertAlreadyInDB"]) = Just "Certificate ignored as it was already in the database" - documentFor (Namespace _ ["OpenedPerasCertDB"]) = Just "Peras certificate database opened" - documentFor (Namespace _ ["ClosedPerasCertDB"]) = Just "Peras certificate database closed" - documentFor (Namespace _ ["AddingPerasCert"]) = Just "Adding certificate to Peras certificate database" + documentFor (Namespace _ ["AddVote"]) = Just "Vote added to Peras vote database" + documentFor (Namespace _ ["GarbageCollected"]) = Just "Garbage collection performed on Peras vote database" documentFor _ = Nothing allNamespaces = - [Namespace [] ["AddedPerasCert"], - Namespace [] ["IgnoredCertAlreadyInDB"], - Namespace [] ["OpenedPerasCertDB"], - Namespace [] ["ClosedPerasCertDB"], - Namespace [] ["AddingPerasCert"]] + [Namespace [] ["AddVote"], + Namespace [] ["GarbageCollected"]] -- ChainDB.TraceAddPerasCertEvent MetaTrace instance instance MetaTrace (ChainDB.TraceAddPerasCertEvent blk) where diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index a0342fffcb3..0a21e2c6c3b 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -91,6 +91,7 @@ import Data.Aeson (Value (..)) import qualified Data.Aeson as Aeson import Data.Foldable (Foldable (..)) import Data.Function (on) +import qualified Data.List.NonEmpty as NonEmpty import Data.Proxy import Data.Text (Text, pack) import qualified Data.Text as Text @@ -185,6 +186,8 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where LedgerDB.InitFailureRead (LedgerDB.ReadMetadataError _ LedgerDB.MetadataBackendMismatch) -> Warning LedgerDB.InitFailureRead (LedgerDB.ReadMetadataError _ LedgerDB.MetadataFileDoesNotExist) -> Warning _ -> Error + LedgerDB.SnapshotRequestDelayed {} -> Info + LedgerDB.SnapshotRequestCompleted -> Info LedgerDB.LedgerReplayEvent {} -> Info LedgerDB.LedgerDBForkerEvent {} -> Debug LedgerDB.LedgerDBFlavorImplEvent {} -> Debug @@ -255,6 +258,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where getSeverityAnnotation ChainDB.TraceChainSelStarvationEvent{} = Debug getSeverityAnnotation ChainDB.TracePerasCertDbEvent{} = Info + getSeverityAnnotation ChainDB.TracePerasVoteDbEvent{} = Info getSeverityAnnotation ChainDB.TraceAddPerasCertEvent{} = Info instance HasSeverityAnnotation (LedgerEvent blk) where @@ -628,6 +632,11 @@ instance ( ConvertRawHash blk ", duration: " <> showT t LedgerDB.DeletedSnapshot snap -> "Deleted old snapshot " <> showT snap + LedgerDB.SnapshotRequestDelayed _snapshotRequestTime delayBeforeSnapshotting slots -> + "Scheduling to take ledger state snapshots at slots " <> showT (NonEmpty.toList slots) + <> ", with randomised delay of" + <> showT delayBeforeSnapshotting + LedgerDB.SnapshotRequestCompleted -> "Completed taking a ledger state snapshot" LedgerDB.LedgerReplayEvent ev' -> case ev' of LedgerDB.TraceReplayStartEvent ev'' -> case ev'' of LedgerDB.ReplayFromGenesis -> @@ -795,6 +804,7 @@ instance ( ConvertRawHash blk ChainDB.ChainSelStarvation RisingEdge -> "Chain Selection was starved." ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> "Chain Selection was unstarved by " <> renderRealPoint pt ChainDB.TracePerasCertDbEvent ev -> showT ev + ChainDB.TracePerasVoteDbEvent ev -> showT ev ChainDB.TraceAddPerasCertEvent ev -> showT ev where showProgressT :: Int -> Int -> Text showProgressT chunkNo outOf = @@ -1083,6 +1093,10 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TracePerasCertDbEvent" , "event" .= show ev ] + toObject _verb (ChainDB.TracePerasVoteDbEvent ev) = + mconcat [ "kind" .= String "TracePerasVoteDbEvent" + , "event" .= show ev + ] toObject _verb (ChainDB.TraceAddPerasCertEvent ev) = mconcat [ "kind" .= String "TraceAddPerasCertEvent" , "event" .= show ev @@ -1104,6 +1118,14 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TraceLedgerDBEvent.LedgerDBSnapshotEvent.InvalidSnapshot" , "snapshot" .= toObject verb snap , "failure" .= show failure ] + LedgerDB.SnapshotRequestDelayed snapshotRequestTime delayBeforeSnapshotting slots -> + mconcat [ "kind" .= String "TraceLedgerDBEvent.LedgerDBSnapshotEvent.SnapshotRequestDelayed" + , "requestTime" .= show snapshotRequestTime + , "delayBeforeSnapshotting " .= show delayBeforeSnapshotting + , "slots" .= show slots] + LedgerDB.SnapshotRequestCompleted -> + mconcat [ "kind" .= String "TraceLedgerDBEvent.LedgerDBSnapshotEvent.SnapshotRequestCompleted" + ] LedgerDB.LedgerReplayEvent ev' -> case ev' of LedgerDB.TraceReplayStartEvent ev'' -> case ev'' of LedgerDB.ReplayFromGenesis -> diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index ab86a6c0300..4ee2bbe26f3 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -24,8 +24,7 @@ import Cardano.Tracing.Config (PartialTraceOptions (..), defaultPartia import Ouroboros.Consensus.Node (NodeDatabasePaths (..)) import Ouroboros.Consensus.Node.Genesis (disableGenesisConfig) import Ouroboros.Consensus.Storage.LedgerDB.Args -import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..), - SnapshotInterval (..)) +import Ouroboros.Consensus.Storage.LedgerDB.Snapshots (defaultSnapshotPolicyArgs) import Ouroboros.Network.Block (SlotNo (..)) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.TxSubmission.Inbound.V2.Types @@ -297,7 +296,7 @@ eExpectedConfig = do , ncConsensusMode = PraosMode , ncGenesisConfig = disableGenesisConfig , ncResponderCoreAffinityPolicy = NoResponderCoreAffinity - , ncLedgerDbConfig = LedgerDbConfiguration DefaultNumOfDiskSnapshots DefaultSnapshotInterval DefaultQueryBatchSize V2InMemory noDeprecatedOptions + , ncLedgerDbConfig = LedgerDbConfiguration defaultSnapshotPolicyArgs DefaultQueryBatchSize V2InMemory noDeprecatedOptions , ncRpcConfig , ncTxSubmissionLogicVersion = TxSubmissionLogicV1 , ncTxSubmissionInitDelay = defaultTxSubmissionInitDelay