diff --git a/.github/workflows/github-page.yml b/.github/workflows/github-page.yml index dd477c8a947..d34343506f7 100644 --- a/.github/workflows/github-page.yml +++ b/.github/workflows/github-page.yml @@ -1,6 +1,9 @@ name: "Haddock documentation" -on: [push] +on: + push: + branches: + - master jobs: build: diff --git a/cardano-cli/ChangeLog.md b/cardano-cli/ChangeLog.md index d6a6bf08af1..f0d1db06d61 100644 --- a/cardano-cli/ChangeLog.md +++ b/cardano-cli/ChangeLog.md @@ -12,6 +12,8 @@ - Allow assembling transactions with no witnesses ([PR 4408](https://github.com/input-output-hk/cardano-node/pull/4408)) +- Add `slotsInEpoch` and `slotsToEpochEnd` to output of `query tip` command ([PR 4912](https://github.com/input-output-hk/cardano-node/pull/4912)) + ### Bugs - Allow reading signing keys from a pipe ([PR 4342](https://github.com/input-output-hk/cardano-node/pull/4342)) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs index d0f35712c9a..409ae00b661 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs @@ -150,6 +150,8 @@ data QueryTipLocalStateOutput = QueryTipLocalStateOutput { localStateChainTip :: ChainTip , mEra :: Maybe AnyCardanoEra , mEpoch :: Maybe EpochNo + , mSlotsInEpoch :: Maybe Word64 + , mSlotsToEpochEnd :: Maybe Word64 , mSyncProgress :: Maybe Text } deriving Show @@ -169,6 +171,8 @@ instance ToJSON QueryTipLocalStateOutput where object $ ( ("era" ..=? mEra a) . ("epoch" ..=? mEpoch a) + . ("slotsInEpoch" ..=? mSlotsInEpoch a) + . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) . ("syncProgress" ..=? mSyncProgress a) ) [] ChainTip slotNo blockHeader blockNo -> @@ -178,6 +182,8 @@ instance ToJSON QueryTipLocalStateOutput where . ("block" ..= blockNo) . ("era" ..=? mEra a) . ("epoch" ..=? mEpoch a) + . ("slotsInEpoch" ..=? mSlotsInEpoch a) + . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) . ("syncProgress" ..=? mSyncProgress a) ) [] toEncoding a = case localStateChainTip a of @@ -185,6 +191,8 @@ instance ToJSON QueryTipLocalStateOutput where pairs $ mconcat $ ( ("era" ..=? mEra a) . ("epoch" ..=? mEpoch a) + . ("slotsInEpoch" ..=? mSlotsInEpoch a) + . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) . ("syncProgress" ..=? mSyncProgress a) ) [] ChainTip slotNo blockHeader blockNo -> @@ -194,6 +202,8 @@ instance ToJSON QueryTipLocalStateOutput where . ("block" ..= blockNo) . ("era" ..=? mEra a) . ("epoch" ..=? mEpoch a) + . ("slotsInEpoch" ..=? mSlotsInEpoch a) + . ("slotsToEpochEnd" ..=? mSlotsToEpochEnd a) . ("syncProgress" ..=? mSyncProgress a) ) [] @@ -206,18 +216,24 @@ instance FromJSON QueryTipLocalStateOutput where mSlot <- o .:? "slot" mHash <- o .:? "hash" mBlock <- o .:? "block" + mSlotsInEpoch' <- o .:? "slotsInEpoch" + mSlotsToEpochEnd' <- o .:? "slotsToEpochEnd" case (mSlot, mHash, mBlock) of (Nothing, Nothing, Nothing) -> pure $ QueryTipLocalStateOutput ChainTipAtGenesis mEra' mEpoch' + mSlotsInEpoch' + mSlotsToEpochEnd' mSyncProgress' (Just slot, Just hash, Just block) -> pure $ QueryTipLocalStateOutput (ChainTip slot hash block) mEra' mEpoch' + mSlotsInEpoch' + mSlotsToEpochEnd' mSyncProgress' (_,_,_) -> fail $ mconcat diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 9e0318c8688..80f3edd510a 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -340,9 +340,11 @@ runQueryTip (AnyConsensusModeParams cModeParams) network mOutFile = do , O.mEra = Nothing , O.mEpoch = Nothing , O.mSyncProgress = Nothing + , O.mSlotsInEpoch = Nothing + , O.mSlotsToEpochEnd = Nothing } - Right (epochNo, _, _) -> do + Right (epochNo, SlotsInEpoch slotsInEpoch, SlotsToEpochEnd slotsToEpochEnd) -> do syncProgressResult <- runExceptT $ do systemStart <- fmap getSystemStart (O.mSystemStart localState) & hoistMaybe ShelleyQueryCmdSystemStartUnavailable nowSeconds <- toRelativeTime (SystemStart systemStart) <$> liftIO getCurrentTime @@ -359,6 +361,8 @@ runQueryTip (AnyConsensusModeParams cModeParams) network mOutFile = do { O.localStateChainTip = chainTip , O.mEra = Just (O.era localState) , O.mEpoch = Just epochNo + , O.mSlotsInEpoch = Just slotsInEpoch + , O.mSlotsToEpochEnd = Just slotsToEpochEnd , O.mSyncProgress = mSyncProgress } diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index dc7a4416963..eb58006f596 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -70,20 +70,19 @@ library Cardano.Node.Handlers.Shutdown Cardano.Node.Handlers.TopLevel Cardano.Node.Orphans + Cardano.Node.Parsers Cardano.Node.Protocol Cardano.Node.Protocol.Alonzo Cardano.Node.Protocol.Byron Cardano.Node.Protocol.Cardano Cardano.Node.Protocol.Shelley Cardano.Node.Protocol.Types - Cardano.Node.Parsers Cardano.Node.Queries Cardano.Node.Run - Cardano.Node.STM Cardano.Node.Startup + Cardano.Node.STM Cardano.Node.TraceConstraints Cardano.Node.Tracing - Cardano.Node.Types Cardano.Node.Tracing.API Cardano.Node.Tracing.Compat Cardano.Node.Tracing.DefaultTraceConfig @@ -91,7 +90,9 @@ library Cardano.Node.Tracing.Era.Byron Cardano.Node.Tracing.Era.HardFork Cardano.Node.Tracing.Era.Shelley + Cardano.Node.Tracing.Formatting Cardano.Node.Tracing.Peers + Cardano.Node.Tracing.Render Cardano.Node.Tracing.StateRep Cardano.Node.Tracing.Tracers Cardano.Node.Tracing.Tracers.BlockReplayProgress @@ -99,32 +100,32 @@ library Cardano.Node.Tracing.Tracers.Consensus Cardano.Node.Tracing.Tracers.ConsensusStartupException Cardano.Node.Tracing.Tracers.Diffusion - Cardano.Node.Tracing.Tracers.KESInfo - Cardano.Node.Tracing.Tracers.StartLeadershipCheck Cardano.Node.Tracing.Tracers.ForgingThreadStats - Cardano.Node.Tracing.Tracers.Resources - Cardano.Node.Tracing.Tracers.Peer - Cardano.Node.Tracing.Tracers.Startup - Cardano.Node.Tracing.Tracers.Shutdown - Cardano.Node.Tracing.Tracers.P2P - Cardano.Node.Tracing.Tracers.NonP2P + Cardano.Node.Tracing.Tracers.KESInfo Cardano.Node.Tracing.Tracers.NodeToClient Cardano.Node.Tracing.Tracers.NodeToNode - Cardano.Node.Tracing.Formatting - Cardano.Node.Tracing.Render + Cardano.Node.Tracing.Tracers.NonP2P + Cardano.Node.Tracing.Tracers.P2P + Cardano.Node.Tracing.Tracers.Peer + Cardano.Node.Tracing.Tracers.Resources + Cardano.Node.Tracing.Tracers.Shutdown + Cardano.Node.Tracing.Tracers.StartLeadershipCheck + Cardano.Node.Tracing.Tracers.Startup + Cardano.Node.Types Cardano.Tracing.Config + Cardano.Tracing.HasIssuer Cardano.Tracing.Metrics - Cardano.Tracing.Peer - Cardano.Tracing.Render - Cardano.Tracing.Startup - Cardano.Tracing.Shutdown - Cardano.Tracing.Tracers Cardano.Tracing.OrphanInstances.Byron Cardano.Tracing.OrphanInstances.Common Cardano.Tracing.OrphanInstances.Consensus Cardano.Tracing.OrphanInstances.HardFork Cardano.Tracing.OrphanInstances.Network Cardano.Tracing.OrphanInstances.Shelley + Cardano.Tracing.Peer + Cardano.Tracing.Render + Cardano.Tracing.Shutdown + Cardano.Tracing.Startup + Cardano.Tracing.Tracers other-modules: Paths_cardano_node autogen-modules: Paths_cardano_node @@ -139,18 +140,19 @@ library , cardano-git-rev , cardano-crypto-class , cardano-crypto-wrapper - , cardano-ledger-core + , cardano-ledger-alonzo + , cardano-ledger-babbage , cardano-ledger-byron + , cardano-ledger-core , cardano-ledger-shelley , cardano-ledger-shelley-ma - , cardano-ledger-alonzo - , cardano-ledger-babbage , cardano-prelude , cardano-protocol-tpraos ^>= 0.1 , cardano-slotting ^>= 0.1 , cborg ^>= 0.2.4 , contra-tracer , containers + , contra-tracer , deepseq , directory , dns @@ -159,9 +161,9 @@ library , filepath , generic-data , hostname - , iproute , io-classes ^>= 0.3 , iohk-monitoring + , iproute , lobemo-backend-aggregation , lobemo-backend-ekg , lobemo-backend-monitoring diff --git a/cardano-node/src/Cardano/Node/TraceConstraints.hs b/cardano-node/src/Cardano/Node/TraceConstraints.hs index 1ea2d14f241..f5f98706f40 100644 --- a/cardano-node/src/Cardano/Node/TraceConstraints.hs +++ b/cardano-node/src/Cardano/Node/TraceConstraints.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} + module Cardano.Node.TraceConstraints (TraceConstraints) where @@ -10,6 +11,7 @@ import Cardano.BM.Tracing (ToObject) import Cardano.Logging (LogFormatting) import Cardano.Node.Queries (ConvertTxId, GetKESInfo (..), HasKESInfo (..), HasKESMetricsData (..), LedgerQueries) +import Cardano.Tracing.HasIssuer (HasIssuer) import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateUpdateError, Header) @@ -25,6 +27,8 @@ import Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId) -- | Tracing-related constraints for monitoring purposes. type TraceConstraints blk = ( ConvertTxId blk + , HasIssuer blk + , HasKESMetricsData blk , HasTxs blk , HasTxId (GenTx blk) , LedgerQueries blk diff --git a/cardano-node/src/Cardano/Tracing/HasIssuer.hs b/cardano-node/src/Cardano/Tracing/HasIssuer.hs new file mode 100644 index 00000000000..37280a716b6 --- /dev/null +++ b/cardano-node/src/Cardano/Tracing/HasIssuer.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +module Cardano.Tracing.HasIssuer + ( BlockIssuerVerificationKeyHash (..) + , HasIssuer (..) + ) where + +import Data.ByteString (ByteString) +import Data.SOP.Strict + +import Cardano.Api (serialiseToRawBytes, verificationKeyHash) +import Cardano.Api.Byron (VerificationKey (ByronVerificationKey)) +import Cardano.Api.Shelley (VerificationKey (StakePoolVerificationKey)) +import qualified Cardano.Chain.Block as Byron +import Cardano.Ledger.Crypto (StandardCrypto) +import qualified Cardano.Ledger.Shelley.API as Shelley + +import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock, Header (..)) +import Ouroboros.Consensus.HardFork.Combinator (HardForkBlock, Header (..), + OneEraHeader (..)) +import Ouroboros.Consensus.Shelley.Ledger.Block (Header (..), ShelleyBlock) + +import Ouroboros.Consensus.Shelley.Protocol.Abstract + +-- | Block issuer verification key hash. +data BlockIssuerVerificationKeyHash + = BlockIssuerVerificationKeyHash !ByteString + -- ^ Serialized block issuer verification key hash. + | NoBlockIssuer + -- ^ There is no block issuer. + -- + -- For example, this could be relevant for epoch boundary blocks (EBBs), + -- genesis blocks, etc. + deriving (Eq, Show) + +-- | Get the block issuer verification key hash from a block header. +class HasIssuer blk where + -- | Given a block header, return the serialized block issuer verification + -- key hash. + getIssuerVerificationKeyHash :: Header blk -> BlockIssuerVerificationKeyHash + +instance HasIssuer ByronBlock where + getIssuerVerificationKeyHash byronBlkHdr = + case byronHeaderRaw byronBlkHdr of + Byron.ABOBBlockHdr hdr -> + BlockIssuerVerificationKeyHash + . serialiseToRawBytes + . verificationKeyHash + . ByronVerificationKey + $ Byron.headerIssuer hdr + Byron.ABOBBoundaryHdr _ -> NoBlockIssuer + +instance + ( ProtoCrypto protocol ~ StandardCrypto + , ProtocolHeaderSupportsProtocol protocol + ) => HasIssuer (ShelleyBlock protocol era) where + getIssuerVerificationKeyHash shelleyBlkHdr = + BlockIssuerVerificationKeyHash + . serialiseToRawBytes + . verificationKeyHash + . StakePoolVerificationKey + $ toStakePoolKey issuer + where + -- We don't support a "block issuer" key role in @cardano-api@, so we'll + -- just convert it to a stake pool key. + toStakePoolKey + :: Shelley.VKey 'Shelley.BlockIssuer era + -> Shelley.VKey 'Shelley.StakePool era + toStakePoolKey vk = Shelley.VKey (Shelley.unVKey vk) + + issuer = pHeaderIssuer (shelleyHeaderRaw shelleyBlkHdr) + +instance All HasIssuer xs => HasIssuer (HardForkBlock xs) where + getIssuerVerificationKeyHash = + hcollapse + . hcmap (Proxy @HasIssuer) (K . getIssuerVerificationKeyHash) + . getOneEraHeader + . getHardForkHeader diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5ea305ffa23..e4eb63d0638 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -34,6 +34,7 @@ import Control.Concurrent (MVar, modifyMVar_) import Control.Concurrent.STM (STM, atomically) import Control.Monad (forM_, when) import Data.Aeson (ToJSON (..), Value (..)) +import qualified Data.ByteString.Base16 as B16 import Data.Functor ((<&>)) import Data.Int (Int64) import Data.IntPSQ (IntPSQ) @@ -42,6 +43,7 @@ import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import Data.Time (NominalDiffTime, UTCTime) import Data.Word (Word64) import GHC.TypeLits (KnownNat, Nat, natVal) @@ -62,8 +64,9 @@ import Cardano.BM.Internal.ElidingTracer import Cardano.BM.Trace (traceNamedObject) import Cardano.BM.Tracing -import Ouroboros.Consensus.Block (BlockConfig, BlockProtocol, CannotForge, ConvertRawHash, - ForgeStateInfo, ForgeStateUpdateError, Header, realPointSlot) +import Ouroboros.Consensus.Block (BlockConfig, BlockProtocol, CannotForge, + ConvertRawHash (..), ForgeStateInfo, ForgeStateUpdateError, Header, + realPointHash, realPointSlot) import Ouroboros.Consensus.BlockchainTime (SystemStart (..), TraceBlockchainTimeEvent (..)) import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError) @@ -110,7 +113,9 @@ import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB import Cardano.Tracing.Config +import Cardano.Tracing.HasIssuer (BlockIssuerVerificationKeyHash (..), HasIssuer (..)) import Cardano.Tracing.Metrics +import Cardano.Tracing.Render (renderChainHash, renderHeaderHash) import Cardano.Tracing.Shutdown () import Cardano.Tracing.Startup () @@ -497,6 +502,7 @@ mkTracers _ _ _ _ _ enableP2P = teeTraceChainTip :: ( ConvertRawHash blk + , HasIssuer blk , LedgerSupportsProtocol blk , InspectLedger blk , ToObject (Header blk) @@ -539,6 +545,8 @@ ignoringSeverity tr = Tracer $ \(WithSeverity _ ev) -> traceWith tr ev traceChainMetrics :: forall blk. () => HasHeader (Header blk) + => ConvertRawHash blk + => HasIssuer blk => Maybe EKGDirect -> STM.TVar Word64 -> BlockConfig blk @@ -550,22 +558,22 @@ traceChainMetrics (Just _ekgDirect) tForks _blockConfig _fStats tr = do Tracer $ \ev -> maybe (pure ()) doTrace (chainTipInformation ev) where - chainTipInformation :: ChainDB.TraceEvent blk -> Maybe ChainInformation + chainTipInformation :: ChainDB.TraceEvent blk -> Maybe (ChainInformation blk) chainTipInformation = \case ChainDB.TraceAddBlockEvent ev -> case ev of ChainDB.SwitchedToAFork _warnings newTipInfo oldChain newChain -> let fork = not $ AF.withinFragmentBounds (AF.headPoint oldChain) newChain in - Just $ chainInformation newTipInfo fork newChain 0 - ChainDB.AddedToCurrentChain _warnings newTipInfo _oldChain newChain -> - Just $ chainInformation newTipInfo False newChain 0 + Just $ chainInformation newTipInfo fork oldChain newChain 0 + ChainDB.AddedToCurrentChain _warnings newTipInfo oldChain newChain -> + Just $ chainInformation newTipInfo False oldChain newChain 0 _ -> Nothing _ -> Nothing - doTrace :: ChainInformation -> IO () + doTrace :: ChainInformation blk -> IO () doTrace - ChainInformation { slots, blocks, density, epoch, slotInEpoch, fork } = do - -- TODO this is executed each time the newFhain changes. How cheap is it? + ChainInformation { slots, blocks, density, epoch, slotInEpoch, fork, tipBlockHash, tipBlockParentHash, tipBlockIssuerVerificationKeyHash } = do + -- TODO this is executed each time the newChain changes. How cheap is it? meta <- mkLOMeta Critical Public traceD tr meta "density" (fromRational density) @@ -576,6 +584,23 @@ traceChainMetrics (Just _ekgDirect) tForks _blockConfig _fStats tr = do when fork $ traceI tr meta "forks" =<< STM.modifyReadTVarIO tForks succ + let tipBlockIssuerVkHashText :: Text + tipBlockIssuerVkHashText = + case tipBlockIssuerVerificationKeyHash of + NoBlockIssuer -> "NoBlockIssuer" + BlockIssuerVerificationKeyHash bs -> + Text.decodeLatin1 (B16.encode bs) + traceNamedObject + (appendName "tipBlockHash" tr) + (meta, LogMessage tipBlockHash) + + traceNamedObject + (appendName "tipBlockParentHash" tr) + (meta, LogMessage tipBlockParentHash) + + traceNamedObject + (appendName "tipBlockIssuerVerificationKeyHash" tr) + (meta, LogMessage tipBlockIssuerVkHashText) traceD :: Trace IO a -> LOMeta -> Text -> Double -> IO () traceD tr meta msg d = traceNamedObject tr (meta, LogValue msg (PureD d)) @@ -1366,7 +1391,8 @@ teeTraceBlockFetchDecision' teeTraceBlockFetchDecision' tr = Tracer $ \(WithSeverity _ peers) -> do meta <- mkLOMeta Info Confidential - traceNamedObject tr (meta, LogValue "connectedPeers" . PureI $ fromIntegral $ length peers) + let tr' = appendName "peers" tr + traceNamedObject tr' (meta, LogValue "connectedPeers" . PureI $ fromIntegral $ length peers) teeTraceBlockFetchDecisionElide :: ( Eq peer @@ -1466,7 +1492,7 @@ traceInboundGovernorCountersMetrics (OnOff True) (Just ekgDirect) = ipgcTracer -- | get information about a chain fragment -data ChainInformation = ChainInformation +data ChainInformation blk = ChainInformation { slots :: Word64 , blocks :: Word64 , density :: Rational @@ -1482,16 +1508,26 @@ data ChainInformation = ChainInformation -- current chain. , fork :: Bool -- ^ Was this a fork. + , tipBlockHash :: Text + -- ^ Hash of the last adopted block. + , tipBlockParentHash :: Text + -- ^ Hash of the parent block of the last adopted block. + , tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash + -- ^ Hash of the last adopted block issuer's verification key. } chainInformation - :: forall blk. HasHeader (Header blk) + :: forall blk. () + => HasHeader (Header blk) + => HasIssuer blk + => ConvertRawHash blk => ChainDB.NewTipInfo blk -> Bool - -> AF.AnchoredFragment (Header blk) + -> AF.AnchoredFragment (Header blk) -- ^ Old fragment. + -> AF.AnchoredFragment (Header blk) -- ^ New fragment. -> Int64 - -> ChainInformation -chainInformation newTipInfo fork frag blocksUncoupledDelta = ChainInformation + -> ChainInformation blk +chainInformation newTipInfo fork oldFrag frag blocksUncoupledDelta = ChainInformation { slots = unSlotNo $ fromWithOrigin 0 (AF.headSlot frag) , blocks = unBlockNo $ fromWithOrigin (BlockNo 1) (AF.headBlockNo frag) , density = fragmentChainDensity frag @@ -1499,7 +1535,19 @@ chainInformation newTipInfo fork frag blocksUncoupledDelta = ChainInformation , slotInEpoch = ChainDB.newTipSlotInEpoch newTipInfo , blocksUncoupledDelta = blocksUncoupledDelta , fork = fork + , tipBlockHash = renderHeaderHash (Proxy @blk) $ realPointHash (ChainDB.newTipPoint newTipInfo) + , tipBlockParentHash = renderChainHash (Text.decodeLatin1 . B16.encode . toRawHash (Proxy @blk)) $ AF.headHash oldFrag + , tipBlockIssuerVerificationKeyHash = tipIssuerVkHash } + where + tipIssuerVkHash :: BlockIssuerVerificationKeyHash + tipIssuerVkHash = + case AF.head frag of + Left AF.AnchorGenesis -> + NoBlockIssuer + Left (AF.Anchor _s _h _b) -> + NoBlockIssuer + Right blk -> getIssuerVerificationKeyHash blk fragmentChainDensity :: HasHeader (Header blk)