{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.HardFork.Combinator.Node.Metrics () where import Data.SOP.Strict import Ouroboros.Consensus.Block.SupportsMetrics import Ouroboros.Consensus.HardFork.Combinator.Abstract import Ouroboros.Consensus.HardFork.Combinator.AcrossEras import Ouroboros.Consensus.HardFork.Combinator.Basics import Ouroboros.Consensus.HardFork.Combinator.Block import Ouroboros.Consensus.Util instance CanHardFork xs => BlockSupportsMetrics (HardForkBlock xs) where isSelfIssued :: BlockConfig (HardForkBlock xs) -> Header (HardForkBlock xs) -> WhetherSelfIssued isSelfIssued BlockConfig (HardForkBlock xs) cfg Header (HardForkBlock xs) hdr = NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued forall k l (h :: (k -> *) -> l -> *) (xs :: l) a. (HCollapse h, SListIN h xs) => h (K a) xs -> CollapseTo h a hcollapse (NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued) -> NS (K WhetherSelfIssued) xs -> CollapseTo NS WhetherSelfIssued forall a b. (a -> b) -> a -> b $ Proxy SingleEraBlock -> (forall a. SingleEraBlock a => BlockConfig a -> Header a -> K WhetherSelfIssued a) -> Prod NS BlockConfig xs -> NS Header xs -> NS (K WhetherSelfIssued) xs forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint) (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *) (f'' :: k -> *). (AllN (Prod h) c xs, HAp h, HAp (Prod h)) => proxy c -> (forall (a :: k). c a => f a -> f' a -> f'' a) -> Prod h f xs -> h f' xs -> h f'' xs hczipWith Proxy SingleEraBlock proxySingle (WhetherSelfIssued -> K WhetherSelfIssued a forall k a (b :: k). a -> K a b K (WhetherSelfIssued -> K WhetherSelfIssued a) -> (BlockConfig a -> Header a -> WhetherSelfIssued) -> BlockConfig a -> Header a -> K WhetherSelfIssued a forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z .: BlockConfig a -> Header a -> WhetherSelfIssued forall blk. BlockSupportsMetrics blk => BlockConfig blk -> Header blk -> WhetherSelfIssued isSelfIssued) (PerEraBlockConfig xs -> NP BlockConfig xs forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs getPerEraBlockConfig (PerEraBlockConfig xs -> NP BlockConfig xs) -> PerEraBlockConfig xs -> NP BlockConfig xs forall a b. (a -> b) -> a -> b $ BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs forall (xs :: [*]). BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs hardForkBlockConfigPerEra BlockConfig (HardForkBlock xs) cfg) (OneEraHeader xs -> NS Header xs forall (xs :: [*]). OneEraHeader xs -> NS Header xs getOneEraHeader (OneEraHeader xs -> NS Header xs) -> OneEraHeader xs -> NS Header xs forall a b. (a -> b) -> a -> b $ Header (HardForkBlock xs) -> OneEraHeader xs forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs getHardForkHeader Header (HardForkBlock xs) hdr)