{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Node () where

import           Data.Proxy
import           Data.SOP.Strict
import           GHC.Stack

import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run

import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Forging ()
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.CommonProtocolParams ()
import           Ouroboros.Consensus.HardFork.Combinator.Ledger.PeerSelection ()
import           Ouroboros.Consensus.HardFork.Combinator.Node.InitStorage ()
import           Ouroboros.Consensus.HardFork.Combinator.Node.Metrics ()
import           Ouroboros.Consensus.HardFork.Combinator.Serialisation

{-------------------------------------------------------------------------------
  ConfigSupportsNode
-------------------------------------------------------------------------------}

instance CanHardFork xs => ConfigSupportsNode (HardForkBlock xs) where
  getSystemStart :: BlockConfig (HardForkBlock xs) -> SystemStart
getSystemStart  = (forall blk.
 ConfigSupportsNode blk =>
 BlockConfig blk -> SystemStart)
-> BlockConfig (HardForkBlock xs) -> SystemStart
forall (xs :: [*]) a.
(CanHardFork xs, Eq a, HasCallStack) =>
(forall blk. ConfigSupportsNode blk => BlockConfig blk -> a)
-> BlockConfig (HardForkBlock xs) -> a
getSameConfigValue forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart
  getNetworkMagic :: BlockConfig (HardForkBlock xs) -> NetworkMagic
getNetworkMagic = (forall blk.
 ConfigSupportsNode blk =>
 BlockConfig blk -> NetworkMagic)
-> BlockConfig (HardForkBlock xs) -> NetworkMagic
forall (xs :: [*]) a.
(CanHardFork xs, Eq a, HasCallStack) =>
(forall blk. ConfigSupportsNode blk => BlockConfig blk -> a)
-> BlockConfig (HardForkBlock xs) -> a
getSameConfigValue forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> NetworkMagic
getNetworkMagic

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

getSameConfigValue
  :: forall xs a. (CanHardFork xs, Eq a, HasCallStack)
  => (forall blk. ConfigSupportsNode blk => BlockConfig blk -> a)
  -> BlockConfig (HardForkBlock xs)
  -> a
getSameConfigValue :: (forall blk. ConfigSupportsNode blk => BlockConfig blk -> a)
-> BlockConfig (HardForkBlock xs) -> a
getSameConfigValue forall blk. ConfigSupportsNode blk => BlockConfig blk -> a
getValue BlockConfig (HardForkBlock xs)
blockConfig = NP (K a) xs -> a
forall k (xs :: [k]) a.
(IsNonEmpty xs, Eq a, SListI xs, HasCallStack) =>
NP (K a) xs -> a
getSameValue NP (K a) xs
values
  where
    values :: NP (K a) xs
    values :: NP (K a) xs
values =
          Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => BlockConfig a -> K a a)
-> NP BlockConfig xs
-> NP (K a) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy SingleEraBlock
forall k (t :: k). Proxy t
Proxy @SingleEraBlock) (a -> K a a
forall k a (b :: k). a -> K a b
K (a -> K a a) -> (BlockConfig a -> a) -> BlockConfig a -> K a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig a -> a
forall blk. ConfigSupportsNode blk => BlockConfig blk -> a
getValue)
        (NP BlockConfig xs -> NP (K a) xs)
-> (BlockConfig (HardForkBlock xs) -> NP BlockConfig xs)
-> BlockConfig (HardForkBlock xs)
-> NP (K a) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerEraBlockConfig xs -> NP BlockConfig xs
forall (xs :: [*]). PerEraBlockConfig xs -> NP BlockConfig xs
getPerEraBlockConfig
        (PerEraBlockConfig xs -> NP BlockConfig xs)
-> (BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs)
-> BlockConfig (HardForkBlock xs)
-> NP BlockConfig xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
forall (xs :: [*]).
BlockConfig (HardForkBlock xs) -> PerEraBlockConfig xs
hardForkBlockConfigPerEra
        (BlockConfig (HardForkBlock xs) -> NP (K a) xs)
-> BlockConfig (HardForkBlock xs) -> NP (K a) xs
forall a b. (a -> b) -> a -> b
$ BlockConfig (HardForkBlock xs)
blockConfig

{-------------------------------------------------------------------------------
  RunNode
-------------------------------------------------------------------------------}

instance ( CanHardFork xs
           -- Instances that must be defined for specific values of @b@:
         , SupportedNetworkProtocolVersion (HardForkBlock xs)
         , SerialiseHFC xs
         ) => RunNode (HardForkBlock xs)