Adapt to single forging thread for all eras.

IntersectMBO/ouroboros-network@378f927
IntersectMBO · Nov 24, 2020 · fa7078e · fa7078e
1 parent 3088aed
commit fa7078e
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 4 deletions.
diff --git a/cabal.project b/cabal.project
@@ -159,7 +159,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 2194d81d745c75dda57063ba89e56e1ec6b37753
+  tag: 378f927be9c325f349c92cd429dd9c4846e5bb78
   --sha256: 0nn1ywww0drvvdsr0yqlgg0dmhjgz9zpdp3rmq94zihbpl4sms99
   subdir:
     io-sim

diff --git a/cardano-node/src/Cardano/Tracing/Metrics.hs b/cardano-node/src/Cardano/Tracing/Metrics.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Tracing.Metrics
@@ -28,7 +29,9 @@ import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
 import           Ouroboros.Consensus.Shelley.Node ()
 import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
 import           Shelley.Spec.Ledger.OCert (KESPeriod (..))
-
+import           Ouroboros.Consensus.HardFork.Combinator.Forging (HardForkForgeStateInfo(..))
+import           Prelude (error)
+import           Data.String (String)
 
 -- | KES-related data to be traced as metrics.
 data KESMetricsData
@@ -79,10 +82,17 @@ instance All HasKESMetricsData xs => HasKESMetricsData (HardForkBlock xs) where
   getKESMetricsData _ forgeStateInfo =
         hcollapse
       . hcmap (Proxy @HasKESMetricsData) getOne
-      . getOneEraForgeStateInfo
-      $ forgeStateInfo
+      $ forgeStateInfo'
     where
       getOne :: forall blk. HasKESMetricsData blk
              => WrapForgeStateInfo blk
              -> K KESMetricsData blk
       getOne = K . getKESMetricsData (Proxy @blk) . unwrapForgeStateInfo
+
+      forgeStateInfo' = case forgeStateInfo of
+        CurrentEraForgeStateUpdated info -> getOneEraForgeStateInfo info
+        CurrentEraLacksBlockForging eraIndex ->
+          error $ missingBlockForgingImpossible eraIndex
+
+      missingBlockForgingImpossible :: EraIndex xs -> String
+      missingBlockForgingImpossible _ = "impossible: current era lacks block forging"