Update dependency on ouroboros-network

Notable changes:
* IntersectMBO/ouroboros-network#2640
* IntersectMBO/ouroboros-network#2649

cabal.project

@@ -282,85 +282,85 @@ source-repository-package
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-network
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: io-sim
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-consensus
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-consensus-byron
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-consensus-shelley
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-consensus-cardano
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: typed-protocols
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: typed-protocols-examples
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: ouroboros-network-framework
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: network-mux
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: io-sim-classes
 
 source-repository-package
  type: git
  location: https://github.com/input-output-hk/ouroboros-network
- tag: 9e498e0962044c582df0cbf2f81fa0450a67d5f7
- --sha256: 000ypfbdc6i6plc91vrcywj4yrw5vvafn7c6993xn1pvd18xjm5g
+ tag: e142c7153b9ff0505a84ec68124f5bd80449eebd
+ --sha256: 1sd418jfd6mavm0kbx7yhyhlmjcl2sc4fnkf3xd9ws13mxz2qbaf
  subdir: Win32-network
 
 constraints:

cardano-node-chairman/app/Cardano/Chairman.hs

@@ -14,7 +14,6 @@ module Cardano.Chairman (chairmanTest) where
 import Cardano.Api.Protocol.Types (SomeNodeClientProtocol (..))
 import Cardano.Node.Types (SocketPath (..))
 import Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show)
-import Control.Concurrent.Async (forConcurrently_)
 import Control.Monad (void)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadST

cardano-node/chairman/Cardano/Chairman.hs

@@ -14,7 +14,6 @@ module Cardano.Chairman (chairmanTest) where
 import Cardano.Prelude hiding (ByteString, STM, atomically, catch, option, show)
 import Prelude (String, error, show)
 
-import Control.Concurrent.Async (forConcurrently_)
 import Control.Monad (void)
 import Data.ByteString.Lazy (ByteString)
 import Data.Coerce (coerce)

cardano-node/src/Cardano/Node/Protocol/Byron.hs

@@ -108,7 +108,7 @@ mkConsensusProtocolByron NodeByronProtocolConfiguration {
  npcByronSupportedProtocolVersionAlt)
  (Update.SoftwareVersion npcByronApplicationName
  npcByronApplicationVersion)
- optionalLeaderCredentials
+ (maybeToList optionalLeaderCredentials)
 
 
 readGenesis :: GenesisFile
@@ -177,9 +177,13 @@ readLeaderCredentials genesisConfig
  . hoistEither
  $ canonicalDecodePretty delegCertFileBytes
 
+ -- The label is used to distinguish multiple sets of credentials
+ -- during tracing. We use the public signing key as the label.
+ let label = Text.pack $ show $ Byron.Crypto.toVerification signingKey
+
  bimapExceptT CredentialsError Just
  . hoistEither
- $ mkByronLeaderCredentials genesisConfig signingKey delegCert
+ $ mkByronLeaderCredentials genesisConfig signingKey delegCert label
 
  where
  deserialiseSigningKey :: LB.ByteString

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

@@ -24,6 +24,7 @@ import Prelude
 
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Except.Extra (firstExceptT)
+import Data.Maybe (maybeToList)
 import qualified Data.Text as T
 
 import qualified Cardano.Chain.Update as Byron
@@ -144,15 +145,15 @@ mkConsensusProtocolCardano NodeByronProtocolConfiguration {
  npcByronSupportedProtocolVersionAlt)
  (Byron.SoftwareVersion npcByronApplicationName
  npcByronApplicationVersion)
- byronLeaderCredentials
+ (maybeToList byronLeaderCredentials)
 
  -- Shelley parameters
  shelleyGenesis
  (Shelley.genesisHashToPraosNonce shelleyGenesisHash)
  (Shelley.ProtVer npcShelleySupportedProtocolVersionMajor
  npcShelleySupportedProtocolVersionMinor)
  (MaxMajorProtVer npcShelleyMaxSupportedProtocolVersion)
- shelleyLeaderCredentials
+ (maybeToList shelleyLeaderCredentials)
 
  -- Hard fork parameters
  npcShelleyHardForkNotBeforeEpoch

cardano-node/src/Cardano/Node/Protocol/Shelley.hs

@@ -33,6 +33,7 @@ import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT
  newExceptT)
 
 import qualified Cardano.Crypto.Hash.Class as Crypto
+import Cardano.Crypto.KES (deriveVerKeyKES)
 
 import qualified Ouroboros.Consensus.Cardano as Consensus
 import Ouroboros.Consensus.Cardano.ShelleyHFC
@@ -110,7 +111,7 @@ mkConsensusProtocolShelley NodeShelleyProtocolConfiguration {
  (ProtVer npcShelleySupportedProtocolVersionMajor
  npcShelleySupportedProtocolVersionMinor)
  (MaxMajorProtVer npcShelleyMaxSupportedProtocolVersion)
- optionalLeaderCredentials
+ (maybeToList optionalLeaderCredentials)
 
 genesisHashToPraosNonce :: GenesisHash -> Nonce
 genesisHashToPraosNonce (GenesisHash h) = Nonce (Crypto.castHash h)
@@ -163,14 +164,19 @@ readLeaderCredentials (Just ProtocolFilepaths {
  KesSigningKey kesKey <-
  firstExceptT FileError . newExceptT $ readFileTextEnvelope (AsSigningKey AsKesKey) kesFile
 
+ -- The label is used to distinguish multiple sets of credentials during
+ -- tracing. We use the public KES key as the label.
+ let label = T.pack (show (deriveVerKeyKES kesKey))
+
  return $ Just TPraosLeaderCredentials {
  tpraosLeaderCredentialsCanBeLeader =
  TPraosCanBeLeader {
  tpraosCanBeLeaderOpCert = opcert,
  tpraosCanBeLeaderColdVerKey = coerceKeyRole vkey,
  tpraosCanBeLeaderSignKeyVRF = vrfKey
  },
- tpraosLeaderCredentialsInitSignKey = kesKey
+ tpraosLeaderCredentialsInitSignKey = kesKey,
+ tpraosLeaderCredentialsLabel = label
  }
 
 -- But not OK to supply some of the files without the others.

cardano-node/src/Cardano/Tracing/Metrics.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Tracing.Metrics
@@ -19,16 +18,15 @@ module Cardano.Tracing.Metrics
 import Cardano.Prelude hiding (All, (:.:))
 
 import Cardano.Crypto.KES.Class (Period)
-import Data.SOP.Strict (All, (:.:)(..), hcmap, K (..), hcollapse)
+import Data.SOP.Strict (All, hcmap, K (..), hcollapse)
 import Ouroboros.Consensus.Block (ForgeStateInfo)
 import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
 import Ouroboros.Consensus.HardFork.Combinator
 import Ouroboros.Consensus.TypeFamilyWrappers (WrapForgeStateInfo (..))
-import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (PerEraForgeStateInfo (..))
+import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (OneEraForgeStateInfo (..))
 import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
 import Ouroboros.Consensus.Shelley.Node ()
 import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
-import qualified Ouroboros.Consensus.Util.OptNP as OptNP
 import Shelley.Spec.Ledger.OCert (KESPeriod (..))
 
 
@@ -79,29 +77,12 @@ instance HasKESMetricsData ByronBlock where
 
 instance All HasKESMetricsData xs => HasKESMetricsData (HardForkBlock xs) where
  getKESMetricsData _ forgeStateInfo =
- combineKESMetrics
- . hcollapse
- . hcmap (Proxy @ HasKESMetricsData) getOne
- . OptNP.toNP
- . getPerEraForgeStateInfo
+ hcollapse
+ . hcmap (Proxy @HasKESMetricsData) getOne
+ . getOneEraForgeStateInfo
  $ forgeStateInfo
  where
  getOne :: forall blk. HasKESMetricsData blk
- => (Maybe :.: WrapForgeStateInfo) blk
+ => WrapForgeStateInfo blk
  -> K KESMetricsData blk
- getOne (Comp mbWrapForgeStateInfo) = K $
- case unwrapForgeStateInfo <$> mbWrapForgeStateInfo of
- Nothing -> NoKESMetricsData
- Just oneForgeStateInfo ->
- getKESMetricsData (Proxy @ blk) oneForgeStateInfo
-
- -- Multiple eras can have 'KESMetricsData', e.g., Shelley and Shelley +
- -- native assets. We don't know which era we're in, so we have to make a
- -- choice: we choose the last era's 'KESMetricsData'.
- --
- -- TODO this might need revision when we have updated everything for the
- -- first hard fork after Shelley, but before it actually happened. At
- -- that moment, we'll trace the KESMetricsData of the upcoming era,
- -- instead of the KESMetricsData of the current Shelley era.
- combineKESMetrics :: [KESMetricsData] -> KESMetricsData
- combineKESMetrics = lastDef NoKESMetricsData
+ getOne = K . getKESMetricsData (Proxy @blk) . unwrapForgeStateInfo

cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs

@@ -35,7 +35,7 @@ import Ouroboros.Consensus.HardFork.Combinator
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..),
  OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraLedgerError (..),
  OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..),
- PerEraForgeStateInfo (..), PerEraForgeStateUpdateError (..), mkEraMismatch)
+ OneEraForgeStateInfo (..), OneEraForgeStateUpdateError (..), mkEraMismatch)
 import Ouroboros.Consensus.HardFork.Combinator.Condense ()
 import Ouroboros.Consensus.HardFork.History.EraParams (EraParams (..), SafeBeforeEpoch,
  SafeZone)
@@ -46,7 +46,6 @@ import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx,
 import Ouroboros.Consensus.Protocol.Abstract (ValidationErr)
 import Ouroboros.Consensus.TypeFamilyWrappers
 import Ouroboros.Consensus.Util.Condense (Condense (..))
-import qualified Ouroboros.Consensus.Util.OptNP as OptNP
 
 
 --
@@ -320,23 +319,21 @@ instance ToObject (CannotForge blk) => ToObject (WrapCannotForge blk) where
 --
 
 -- It's a type alias:
--- type HardForkForgeStateInfo xs = PerEraForgeStateInfo xs
+-- type HardForkForgeStateInfo xs = OneEraForgeStateInfo xs
 
-instance All (ToObject `Compose` WrapForgeStateInfo) xs => ToObject (PerEraForgeStateInfo xs) where
+instance All (ToObject `Compose` WrapForgeStateInfo) xs => ToObject (OneEraForgeStateInfo xs) where
  toObject verb forgeStateInfo =
  mkObject
  [ "kind" .= String "HardForkForgeStateInfo"
- , "forgeStateInfos" .= toJSON forgeStateInfos
+ , "forgeStateInfo" .= toJSON forgeStateInfo'
  ]
  where
- forgeStateInfos :: [Object]
- forgeStateInfos =
- catMaybes
- . hcollapse
+ forgeStateInfo' :: Object
+ forgeStateInfo' =
+ hcollapse
  . hcmap (Proxy @ (ToObject `Compose` WrapForgeStateInfo))
- (K . fmap (toObject verb) . unComp)
- . OptNP.toNP
- . getPerEraForgeStateInfo
+ (K . toObject verb)
+ . getOneEraForgeStateInfo
  $ forgeStateInfo
 
 instance ToObject (ForgeStateInfo blk) => ToObject (WrapForgeStateInfo blk) where
@@ -348,23 +345,21 @@ instance ToObject (ForgeStateInfo blk) => ToObject (WrapForgeStateInfo blk) wher
 --
 
 -- It's a type alias:
--- type HardForkForgeStateUpdateError xs = PerEraForgeStateUpdateError xs
+-- type HardForkForgeStateUpdateError xs = OneEraForgeStateUpdateError xs
 
-instance All (ToObject `Compose` WrapForgeStateUpdateError) xs => ToObject (PerEraForgeStateUpdateError xs) where
+instance All (ToObject `Compose` WrapForgeStateUpdateError) xs => ToObject (OneEraForgeStateUpdateError xs) where
  toObject verb forgeStateUpdateError =
  mkObject
  [ "kind" .= String "HardForkForgeStateUpdateError"
- , "forgeStateUpdateErrors" .= toJSON forgeStateUpdateErrors
+ , "forgeStateUpdateError" .= toJSON forgeStateUpdateError'
  ]
  where
- forgeStateUpdateErrors :: [Object]
- forgeStateUpdateErrors =
- catMaybes
- . hcollapse
+ forgeStateUpdateError' :: Object
+ forgeStateUpdateError' =
+ hcollapse
  . hcmap (Proxy @ (ToObject `Compose` WrapForgeStateUpdateError))
- (K . fmap (toObject verb) . unComp)
- . OptNP.toNP
- . getPerEraForgeStateUpdateError
+ (K . toObject verb)
+ . getOneEraForgeStateUpdateError
  $ forgeStateUpdateError
 
 instance ToObject (ForgeStateUpdateError blk) => ToObject (WrapForgeStateUpdateError blk) where

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

@@ -447,13 +447,15 @@ mkConsensusTracers trSel verb tr nodeKern bcCounters = do
  annotateSeverity $ teeTraceBlockFetchDecision verb elidedFetchDecision $ appendName "BlockFetchDecision" tr
  , Consensus.blockFetchClientTracer = tracerOnOff (traceBlockFetchClient trSel) verb "BlockFetchClient" tr
  , Consensus.blockFetchServerTracer = tracerOnOff (traceBlockFetchServer trSel) verb "BlockFetchServer" tr
- , Consensus.forgeStateInfoTracer = tracerOnOff' (traceForgeStateInfo trSel) $ forgeStateInfoTracer (Proxy @ blk) trSel tr
+ , Consensus.forgeStateInfoTracer = tracerOnOff' (traceForgeStateInfo trSel) $
+ contramap (\(Consensus.TraceLabelCreds _ ev) -> ev) $
+ forgeStateInfoTracer (Proxy @ blk) trSel tr
  , Consensus.txInboundTracer = tracerOnOff (traceTxInbound trSel) verb "TxInbound" tr
  , Consensus.txOutboundTracer = tracerOnOff (traceTxOutbound trSel) verb "TxOutbound" tr
  , Consensus.localTxSubmissionServerTracer = tracerOnOff (traceLocalTxSubmissionServer trSel) verb "LocalTxSubmissionServer" tr
  , Consensus.mempoolTracer = tracerOnOff' (traceMempool trSel) $ mempoolTracer trSel tr bcCounters
  , Consensus.forgeTracer = tracerOnOff' (traceForge trSel) $
- Tracer $ \ev -> do
+ Tracer $ \(Consensus.TraceLabelCreds _ ev) -> do
  traceWith (forgeTracer verb tr forgeTracers nodeKern bcCounters) ev
  traceWith (blockForgeOutcomeExtractor
  $ toLogObject' verb