{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.HardFork.Combinator.Node.SanityCheck () where

import           Data.List.NonEmpty (NonEmpty (..))
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Strict
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.History.EpochInfo
import           Ouroboros.Consensus.Protocol.Abstract

instance CanHardFork xs => BlockSupportsSanityCheck (HardForkBlock xs) where
  configAllSecurityParams :: TopLevelConfig (HardForkBlock xs) -> NonEmpty SecurityParam
configAllSecurityParams TopLevelConfig (HardForkBlock xs)
tlc =
    let configProtocol :: ConsensusConfig (BlockProtocol (HardForkBlock xs))
configProtocol = TopLevelConfig (HardForkBlock xs)
-> ConsensusConfig (BlockProtocol (HardForkBlock xs))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigProtocol TopLevelConfig (HardForkBlock xs)
tlc in
    ConsensusConfig (HardForkProtocol xs) -> SecurityParam
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> SecurityParam
hardForkConsensusConfigK ConsensusConfig (HardForkProtocol xs)
configProtocol SecurityParam -> [SecurityParam] -> NonEmpty SecurityParam
forall a. a -> [a] -> NonEmpty a
:|
      PerEraConsensusConfig xs -> [SecurityParam]
forall (xs :: [*]).
All SingleEraBlock xs =>
PerEraConsensusConfig xs -> [SecurityParam]
perEraConsensusConfigSecurityParams (ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
forall (xs :: [*]).
ConsensusConfig (HardForkProtocol xs) -> PerEraConsensusConfig xs
hardForkConsensusConfigPerEra ConsensusConfig (HardForkProtocol xs)
configProtocol)

perEraConsensusConfigSecurityParams
  :: All SingleEraBlock xs
  => PerEraConsensusConfig xs -> [SecurityParam]
perEraConsensusConfigSecurityParams :: forall (xs :: [*]).
All SingleEraBlock xs =>
PerEraConsensusConfig xs -> [SecurityParam]
perEraConsensusConfigSecurityParams (PerEraConsensusConfig NP WrapPartialConsensusConfig xs
xs) =
  K [SecurityParam] () -> [SecurityParam]
forall {k} a (b :: k). K a b -> a
unK (K [SecurityParam] () -> [SecurityParam])
-> K [SecurityParam] () -> [SecurityParam]
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialConsensusConfig a -> K [SecurityParam] ())
-> NP WrapPartialConsensusConfig xs
-> K [SecurityParam] ()
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (g :: * -> *) (proxy :: (k -> Constraint) -> *)
       (f :: k -> *).
(HTraverse_ h, AllN h c xs, Applicative g) =>
proxy c -> (forall (a :: k). c a => f a -> g ()) -> h f xs -> g ()
forall (c :: * -> Constraint) (xs :: [*]) (g :: * -> *)
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
(AllN NP c xs, Applicative g) =>
proxy c -> (forall a. c a => f a -> g ()) -> NP f xs -> g ()
hctraverse_ (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @SingleEraBlock) WrapPartialConsensusConfig a -> K [SecurityParam] ()
forall a.
SingleEraBlock a =>
WrapPartialConsensusConfig a -> K [SecurityParam] ()
go NP WrapPartialConsensusConfig xs
xs
    where
      go :: forall a . SingleEraBlock a
         => WrapPartialConsensusConfig a -> K [SecurityParam] ()
      go :: forall a.
SingleEraBlock a =>
WrapPartialConsensusConfig a -> K [SecurityParam] ()
go (WrapPartialConsensusConfig PartialConsensusConfig (BlockProtocol a)
c) =
        [SecurityParam] -> K [SecurityParam] ()
forall k a (b :: k). a -> K a b
K [ ConsensusConfig (BlockProtocol a) -> SecurityParam
forall p. ConsensusProtocol p => ConsensusConfig p -> SecurityParam
protocolSecurityParam (Proxy (BlockProtocol a)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol a)
-> ConsensusConfig (BlockProtocol a)
forall p (proxy :: * -> *).
HasPartialConsensusConfig p =>
proxy p
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig p
-> ConsensusConfig p
forall (proxy :: * -> *).
proxy (BlockProtocol a)
-> EpochInfo (Except PastHorizonException)
-> PartialConsensusConfig (BlockProtocol a)
-> ConsensusConfig (BlockProtocol a)
completeConsensusConfig (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BlockProtocol a)) EpochInfo (Except PastHorizonException)
dummyEpochInfo PartialConsensusConfig (BlockProtocol a)
c) ]